home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / perl / os2perl / eval.c < prev    next >
C/C++ Source or Header  |  1991-06-11  |  72KB  |  2,942 lines
  1. /* $RCSfile: eval.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:07:23 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  * $Log:    eval.c,v $
  9.  * Revision 4.0.1.2  91/06/07  11:07:23  lwall
  10.  * patch4: new copyright notice
  11.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  12.  * patch4: assignment wasn't correctly de-tainting the assigned variable.
  13.  * patch4: default top-of-form format is now FILEHANDLE_TOP
  14.  * patch4: added $^P variable to control calling of perldb routines
  15.  * patch4: taintchecks could improperly modify parent in vfork()
  16.  * patch4: many, many itty-bitty portability fixes
  17.  *
  18.  * Revision 4.0.1.1  91/04/11  17:43:48  lwall
  19.  * patch1: fixed failed fork to return undef as documented
  20.  * patch1: reduced maximum branch distance in eval.c
  21.  *
  22.  * Revision 4.0  91/03/20  01:16:48  lwall
  23.  * 4.0 baseline.
  24.  *
  25.  */
  26.  
  27. #include "EXTERN.h"
  28. #include "perl.h"
  29.  
  30. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  31. #include <signal.h>
  32. #endif
  33.  
  34. #ifdef I_FCNTL
  35. #include <fcntl.h>
  36. #endif
  37. #ifdef MSDOS
  38. /* I_FCNTL *MUST* not be defined for MS-DOS and OS/2
  39.    but fcntl.h is required for O_BINARY */
  40. #include <fcntl.h>
  41. #endif
  42. #ifdef I_SYS_FILE
  43. #include <sys/file.h>
  44. #endif
  45. #ifdef I_VFORK
  46. #   include <vfork.h>
  47. #endif
  48.  
  49. #ifdef VOIDSIG
  50. static void (*ihand)();
  51. static void (*qhand)();
  52. #else
  53. static int (*ihand)();
  54. static int (*qhand)();
  55. #endif
  56.  
  57. ARG *debarg;
  58. STR str_args;
  59. static STAB *stab2;
  60. static STIO *stio;
  61. static struct lstring *lstr;
  62. static int old_rschar;
  63. static int old_rslen;
  64.  
  65. double sin(), cos(), atan2(), pow();
  66.  
  67. char *getlogin();
  68.  
  69. int
  70. eval(arg,gimme,sp)
  71. register ARG *arg;
  72. int gimme;
  73. register int sp;
  74. {
  75.     register STR *str;
  76.     register int anum;
  77.     register int optype;
  78.     register STR **st;
  79.     int maxarg;
  80.     double value;
  81.     register char *tmps;
  82.     char *tmps2;
  83.     int argflags;
  84.     int argtype;
  85.     union argptr argptr;
  86.     int arglast[8];    /* highest sp for arg--valid only for non-O_LIST args */
  87.     unsigned long tmplong;
  88.     long when;
  89.     FILE *fp;
  90.     STR *tmpstr;
  91.     FCMD *form;
  92.     STAB *stab;
  93.     ARRAY *ary;
  94.     bool assigning = FALSE;
  95.     double exp(), log(), sqrt(), modf();
  96.     char *crypt(), *getenv();
  97.     extern void grow_dlevel();
  98.  
  99.     if (!arg)
  100.     goto say_undef;
  101.     optype = arg->arg_type;
  102.     maxarg = arg->arg_len;
  103.     arglast[0] = sp;
  104.     str = arg->arg_ptr.arg_str;
  105.     if (sp + maxarg > stack->ary_max)
  106.     astore(stack, sp + maxarg, Nullstr);
  107.     st = stack->ary_array;
  108.  
  109. #ifdef DEBUGGING
  110.     if (debug) {
  111.     if (debug & 8) {
  112.         deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg);
  113.     }
  114.     debname[dlevel] = opname[optype][0];
  115.     debdelim[dlevel] = ':';
  116.     if (++dlevel >= dlmax)
  117.         grow_dlevel();
  118.     }
  119. #endif
  120.  
  121.     for (anum = 1; anum <= maxarg; anum++) {
  122.     argflags = arg[anum].arg_flags;
  123.     argtype = arg[anum].arg_type;
  124.     argptr = arg[anum].arg_ptr;
  125.       re_eval:
  126.     switch (argtype) {
  127.     default:
  128.         st[++sp] = &str_undef;
  129. #ifdef DEBUGGING
  130.         tmps = "NULL";
  131. #endif
  132.         break;
  133.     case A_EXPR:
  134. #ifdef DEBUGGING
  135.         if (debug & 8) {
  136.         tmps = "EXPR";
  137.         deb("%d.EXPR =>\n",anum);
  138.         }
  139. #endif
  140.         sp = eval(argptr.arg_arg,
  141.         (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp);
  142.         if (sp + (maxarg - anum) > stack->ary_max)
  143.         astore(stack, sp + (maxarg - anum), Nullstr);
  144.         st = stack->ary_array;    /* possibly reallocated */
  145.         break;
  146.     case A_CMD:
  147. #ifdef DEBUGGING
  148.         if (debug & 8) {
  149.         tmps = "CMD";
  150.         deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd);
  151.         }
  152. #endif
  153.         sp = cmd_exec(argptr.arg_cmd, gimme, sp);
  154.         if (sp + (maxarg - anum) > stack->ary_max)
  155.         astore(stack, sp + (maxarg - anum), Nullstr);
  156.         st = stack->ary_array;    /* possibly reallocated */
  157.         break;
  158.     case A_LARYSTAB:
  159.         ++sp;
  160.         switch (optype) {
  161.         case O_ITEM2: argtype = 2; break;
  162.         case O_ITEM3: argtype = 3; break;
  163.         default:      argtype = anum; break;
  164.         }
  165.         str = afetch(stab_array(argptr.arg_stab),
  166.         arg[argtype].arg_len - arybase, TRUE);
  167. #ifdef DEBUGGING
  168.         if (debug & 8) {
  169.         (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  170.             arg[argtype].arg_len);
  171.         tmps = buf;
  172.         }
  173. #endif
  174.         goto do_crement;
  175.     case A_ARYSTAB:
  176.         switch (optype) {
  177.         case O_ITEM2: argtype = 2; break;
  178.         case O_ITEM3: argtype = 3; break;
  179.         default:      argtype = anum; break;
  180.         }
  181.         st[++sp] = afetch(stab_array(argptr.arg_stab),
  182.         arg[argtype].arg_len - arybase, FALSE);
  183. #ifdef DEBUGGING
  184.         if (debug & 8) {
  185.         (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
  186.             arg[argtype].arg_len);
  187.         tmps = buf;
  188.         }
  189. #endif
  190.         break;
  191.     case A_STAR:
  192.         stab = argptr.arg_stab;
  193.         st[++sp] = (STR*)stab;
  194.         if (!stab_xarray(stab))
  195.         aadd(stab);
  196.         if (!stab_xhash(stab))
  197.         hadd(stab);
  198.         if (!stab_io(stab))
  199.         stab_io(stab) = stio_new();
  200. #ifdef DEBUGGING
  201.         if (debug & 8) {
  202.         (void)sprintf(buf,"STAR *%s",stab_name(argptr.arg_stab));
  203.         tmps = buf;
  204.         }
  205. #endif
  206.         break;
  207.     case A_LSTAR:
  208.         str = st[++sp] = (STR*)argptr.arg_stab;
  209. #ifdef DEBUGGING
  210.         if (debug & 8) {
  211.         (void)sprintf(buf,"LSTAR *%s",stab_name(argptr.arg_stab));
  212.         tmps = buf;
  213.         }
  214. #endif
  215.         break;
  216.     case A_STAB:
  217.         st[++sp] = STAB_STR(argptr.arg_stab);
  218. #ifdef DEBUGGING
  219.         if (debug & 8) {
  220.         (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab));
  221.         tmps = buf;
  222.         }
  223. #endif
  224.         break;
  225.     case A_LENSTAB:
  226.         str_numset(str, (double)STAB_LEN(argptr.arg_stab));
  227.         st[++sp] = str;
  228. #ifdef DEBUGGING
  229.         if (debug & 8) {
  230.         (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab));
  231.         tmps = buf;
  232.         }
  233. #endif
  234.         break;
  235.     case A_LEXPR:
  236. #ifdef DEBUGGING
  237.         if (debug & 8) {
  238.         tmps = "LEXPR";
  239.         deb("%d.LEXPR =>\n",anum);
  240.         }
  241. #endif
  242.         if (argflags & AF_ARYOK) {
  243.         sp = eval(argptr.arg_arg, G_ARRAY, sp);
  244.         if (sp + (maxarg - anum) > stack->ary_max)
  245.             astore(stack, sp + (maxarg - anum), Nullstr);
  246.         st = stack->ary_array;    /* possibly reallocated */
  247.         }
  248.         else {
  249.         sp = eval(argptr.arg_arg, G_SCALAR, sp);
  250.         st = stack->ary_array;    /* possibly reallocated */
  251.         str = st[sp];
  252.         goto do_crement;
  253.         }
  254.         break;
  255.     case A_LVAL:
  256. #ifdef DEBUGGING
  257.         if (debug & 8) {
  258.         (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab));
  259.         tmps = buf;
  260.         }
  261. #endif
  262.         ++sp;
  263.         str = STAB_STR(argptr.arg_stab);
  264.         if (!str)
  265.         fatal("panic: A_LVAL");
  266.       do_crement:
  267.         assigning = TRUE;
  268.         if (argflags & AF_PRE) {
  269.         if (argflags & AF_UP)
  270.             str_inc(str);
  271.         else
  272.             str_dec(str);
  273.         STABSET(str);
  274.         st[sp] = str;
  275.         str = arg->arg_ptr.arg_str;
  276.         }
  277.         else if (argflags & AF_POST) {
  278.         st[sp] = str_mortal(str);
  279.         if (argflags & AF_UP)
  280.             str_inc(str);
  281.         else
  282.             str_dec(str);
  283.         STABSET(str);
  284.         str = arg->arg_ptr.arg_str;
  285.         }
  286.         else
  287.         st[sp] = str;
  288.         break;
  289.     case A_LARYLEN:
  290.         ++sp;
  291.         stab = argptr.arg_stab;
  292.         str = stab_array(argptr.arg_stab)->ary_magic;
  293.         if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST))
  294.         str_numset(str,(double)(stab_array(stab)->ary_fill+arybase));
  295. #ifdef DEBUGGING
  296.         tmps = "LARYLEN";
  297. #endif
  298.         if (!str)
  299.         fatal("panic: A_LEXPR");
  300.         goto do_crement;
  301.     case A_ARYLEN:
  302.         stab = argptr.arg_stab;
  303.         st[++sp] = stab_array(stab)->ary_magic;
  304.         str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase));
  305. #ifdef DEBUGGING
  306.         tmps = "ARYLEN";
  307. #endif
  308.         break;
  309.     case A_SINGLE:
  310.         st[++sp] = argptr.arg_str;
  311. #ifdef DEBUGGING
  312.         tmps = "SINGLE";
  313. #endif
  314.         break;
  315.     case A_DOUBLE:
  316.         (void) interp(str,argptr.arg_str,sp);
  317.         st = stack->ary_array;
  318.         st[++sp] = str;
  319. #ifdef DEBUGGING
  320.         tmps = "DOUBLE";
  321. #endif
  322.         break;
  323.     case A_BACKTICK:
  324.         tmps = str_get(interp(str,argptr.arg_str,sp));
  325.         st = stack->ary_array;
  326. #ifdef TAINT
  327.         taintproper("Insecure dependency in ``");
  328. #endif
  329.         fp = mypopen(tmps,"r");
  330.         str_set(str,"");
  331.         if (fp) {
  332.         if (gimme == G_SCALAR) {
  333.             while (str_gets(str,fp,str->str_cur) != Nullch)
  334.             ;
  335.         }
  336.         else {
  337.             for (;;) {
  338.             if (++sp > stack->ary_max) {
  339.                 astore(stack, sp, Nullstr);
  340.                 st = stack->ary_array;
  341.             }
  342.             str = st[sp] = Str_new(56,80);
  343.             if (str_gets(str,fp,0) == Nullch) {
  344.                 sp--;
  345.                 break;
  346.             }
  347.             if (str->str_len - str->str_cur > 20) {
  348.                 str->str_len = str->str_cur+1;
  349.                 Renew(str->str_ptr, str->str_len, char);
  350.             }
  351.             str_2mortal(str);
  352.             }
  353.         }
  354.         statusvalue = mypclose(fp);
  355.         }
  356.         else
  357.         statusvalue = -1;
  358.  
  359.         if (gimme == G_SCALAR)
  360.         st[++sp] = str;
  361. #ifdef DEBUGGING
  362.         tmps = "BACK";
  363. #endif
  364.         break;
  365.     case A_WANTARRAY:
  366.         {
  367.         if (curcsv->wantarray == G_ARRAY)
  368.             st[++sp] = &str_yes;
  369.         else
  370.             st[++sp] = &str_no;
  371.         }
  372. #ifdef DEBUGGING
  373.         tmps = "WANTARRAY";
  374. #endif
  375.         break;
  376.     case A_INDREAD:
  377.         last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE);
  378.         old_rschar = rschar;
  379.         old_rslen = rslen;
  380.         goto do_read;
  381.     case A_GLOB:
  382.         argflags |= AF_POST;    /* enable newline chopping */
  383.         last_in_stab = argptr.arg_stab;
  384.         old_rschar = rschar;
  385.         old_rslen = rslen;
  386.         rslen = 1;
  387. #ifdef MSDOS
  388.         rschar = 0;
  389. #else
  390. #ifdef CSH
  391.         rschar = 0;
  392. #else
  393.         rschar = '\n';
  394. #endif    /* !CSH */
  395. #endif    /* !MSDOS */
  396.         goto do_read;
  397.     case A_READ:
  398.         last_in_stab = argptr.arg_stab;
  399.         old_rschar = rschar;
  400.         old_rslen = rslen;
  401.       do_read:
  402.         if (anum > 1)        /* assign to scalar */
  403.         gimme = G_SCALAR;    /* force context to scalar */
  404.         if (gimme == G_ARRAY)
  405.         str = Str_new(57,0);
  406.         ++sp;
  407.         fp = Nullfp;
  408.         if (stab_io(last_in_stab)) {
  409.         fp = stab_io(last_in_stab)->ifp;
  410.         if (!fp) {
  411.             if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  412.             if (stab_io(last_in_stab)->flags & IOF_START) {
  413.                 stab_io(last_in_stab)->flags &= ~IOF_START;
  414.                 stab_io(last_in_stab)->lines = 0;
  415.                 if (alen(stab_array(last_in_stab)) < 0) {
  416.                 tmpstr = str_make("-",1); /* assume stdin */
  417.                 (void)apush(stab_array(last_in_stab), tmpstr);
  418.                 }
  419.             }
  420.             fp = nextargv(last_in_stab);
  421.             if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */
  422.                 (void)do_close(last_in_stab,FALSE); /* now it does*/
  423.                 stab_io(last_in_stab)->flags |= IOF_START;
  424.             }
  425.             }
  426.             else if (argtype == A_GLOB) {
  427.             (void) interp(str,stab_val(last_in_stab),sp);
  428.             st = stack->ary_array;
  429.             tmpstr = Str_new(55,0);
  430. #ifdef MSDOS
  431.             str_set(tmpstr, "perlglob ");
  432.             str_scat(tmpstr,str);
  433.             str_cat(tmpstr," |");
  434. #else
  435. #ifdef CSH
  436.             str_nset(tmpstr,cshname,cshlen);
  437.             str_cat(tmpstr," -cf 'set nonomatch; glob ");
  438.             str_scat(tmpstr,str);
  439.             str_cat(tmpstr,"'|");
  440. #else
  441.             str_set(tmpstr, "echo ");
  442.             str_scat(tmpstr,str);
  443.             str_cat(tmpstr,
  444.               "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
  445. #endif /* !CSH */
  446. #endif /* !MSDOS */
  447.             (void)do_open(last_in_stab,tmpstr->str_ptr,
  448.               tmpstr->str_cur);
  449.             fp = stab_io(last_in_stab)->ifp;
  450.             str_free(tmpstr);
  451.             }
  452.         }
  453.         }
  454.         if (!fp && dowarn)
  455.         warn("Read on closed filehandle <%s>",stab_name(last_in_stab));
  456.         when = str->str_len;    /* remember if already alloced */
  457.         if (!when)
  458.         Str_Grow(str,80);    /* try short-buffering it */
  459.       keepgoing:
  460.         if (!fp)
  461.         st[sp] = &str_undef;
  462.         else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) {
  463.         clearerr(fp);
  464.         if (stab_io(last_in_stab)->flags & IOF_ARGV) {
  465.             fp = nextargv(last_in_stab);
  466.             if (fp)
  467.             goto keepgoing;
  468.             (void)do_close(last_in_stab,FALSE);
  469.             stab_io(last_in_stab)->flags |= IOF_START;
  470.         }
  471.         else if (argflags & AF_POST) {
  472.             (void)do_close(last_in_stab,FALSE);
  473.         }
  474.         st[sp] = &str_undef;
  475.         rschar = old_rschar;
  476.         rslen = old_rslen;
  477.         if (gimme == G_ARRAY) {
  478.             --sp;
  479.             str_2mortal(str);
  480.             goto array_return;
  481.         }
  482.         break;
  483.         }
  484.         else {
  485.         stab_io(last_in_stab)->lines++;
  486.         st[sp] = str;
  487. #ifdef TAINT
  488.         str->str_tainted = 1; /* Anything from the outside world...*/
  489. #endif
  490.         if (argflags & AF_POST) {
  491.             if (str->str_cur > 0)
  492.             str->str_cur--;
  493.             if (str->str_ptr[str->str_cur] == rschar)
  494.             str->str_ptr[str->str_cur] = '\0';
  495.             else
  496.             str->str_cur++;
  497.             for (tmps = str->str_ptr; *tmps; tmps++)
  498.             if (!isalpha(*tmps) && !isdigit(*tmps) &&
  499.                 index("$&*(){}[]'\";\\|?<>~`",*tmps))
  500.                 break;
  501.             if (*tmps && stat(str->str_ptr,&statbuf) < 0)
  502.             goto keepgoing;        /* unmatched wildcard? */
  503.         }
  504.         if (gimme == G_ARRAY) {
  505.             if (str->str_len - str->str_cur > 20) {
  506.             str->str_len = str->str_cur+1;
  507.             Renew(str->str_ptr, str->str_len, char);
  508.             }
  509.             str_2mortal(str);
  510.             if (++sp > stack->ary_max) {
  511.             astore(stack, sp, Nullstr);
  512.             st = stack->ary_array;
  513.             }
  514.             str = Str_new(58,80);
  515.             goto keepgoing;
  516.         }
  517.         else if (!when && str->str_len - str->str_cur > 80) {
  518.             /* try to reclaim a bit of scalar space on 1st alloc */
  519.             if (str->str_cur < 60)
  520.             str->str_len = 80;
  521.             else
  522.             str->str_len = str->str_cur+40;    /* allow some slop */
  523.             Renew(str->str_ptr, str->str_len, char);
  524.         }
  525.         }
  526.         rschar = old_rschar;
  527.         rslen = old_rslen;
  528. #ifdef DEBUGGING
  529.         tmps = "READ";
  530. #endif
  531.         break;
  532.     }
  533. #ifdef DEBUGGING
  534.     if (debug & 8)
  535.         deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp]));
  536. #endif
  537.     if (anum < 8)
  538.         arglast[anum] = sp;
  539.     }
  540.  
  541.     st += arglast[0];
  542. #ifdef SMALLSWITCHES
  543.     if (optype < O_CHOWN)
  544. #endif
  545.     switch (optype) {
  546.     case O_RCAT:
  547.     STABSET(str);
  548.     break;
  549.     case O_ITEM:
  550.     if (gimme == G_ARRAY)
  551.         goto array_return;
  552.     /* FALL THROUGH */
  553.     case O_SCALAR:
  554.     STR_SSET(str,st[1]);
  555.     STABSET(str);
  556.     break;
  557.     case O_ITEM2:
  558.     if (gimme == G_ARRAY)
  559.         goto array_return;
  560.     --anum;
  561.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  562.     STABSET(str);
  563.     break;
  564.     case O_ITEM3:
  565.     if (gimme == G_ARRAY)
  566.     goto array_return;
  567.     --anum;
  568.     STR_SSET(str,st[arglast[anum]-arglast[0]]);
  569.     STABSET(str);
  570.     break;
  571.     case O_CONCAT:
  572.     STR_SSET(str,st[1]);
  573.     str_scat(str,st[2]);
  574.     STABSET(str);
  575.     break;
  576.     case O_REPEAT:
  577.     if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) {
  578.         sp = do_repeatary(arglast);
  579.         goto array_return;
  580.     }
  581.     STR_SSET(str,st[arglast[1] - arglast[0]]);
  582.     anum = (int)str_gnum(st[arglast[2] - arglast[0]]);
  583.     if (anum >= 1) {
  584.         tmpstr = Str_new(50, 0);
  585.         tmps = str_get(str);
  586.         str_nset(tmpstr,tmps,str->str_cur);
  587.         tmps = str_get(tmpstr);    /* force to be string */
  588.         STR_GROW(str, (anum * str->str_cur) + 1);
  589.         repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum);
  590.         str->str_cur *= anum;
  591.         str->str_ptr[str->str_cur] = '\0';
  592.         str->str_nok = 0;
  593.         str_free(tmpstr);
  594.     }
  595.     else
  596.         str_sset(str,&str_no);
  597.     STABSET(str);
  598.     break;
  599.     case O_MATCH:
  600.     sp = do_match(str,arg,
  601.       gimme,arglast);
  602.     if (gimme == G_ARRAY)
  603.         goto array_return;
  604.     STABSET(str);
  605.     break;
  606.     case O_NMATCH:
  607.     sp = do_match(str,arg,
  608.       G_SCALAR,arglast);
  609.     str_sset(str, str_true(str) ? &str_no : &str_yes);
  610.     STABSET(str);
  611.     break;
  612.     case O_SUBST:
  613.     sp = do_subst(str,arg,arglast[0]);
  614.     goto array_return;
  615.     case O_NSUBST:
  616.     sp = do_subst(str,arg,arglast[0]);
  617.     str = arg->arg_ptr.arg_str;
  618.     str_set(str, str_true(str) ? No : Yes);
  619.     goto array_return;
  620.     case O_ASSIGN:
  621.     if (arg[1].arg_flags & AF_ARYOK) {
  622.         if (arg->arg_len == 1) {
  623.         arg->arg_type = O_LOCAL;
  624.         goto local;
  625.         }
  626.         else {
  627.         arg->arg_type = O_AASSIGN;
  628.         goto aassign;
  629.         }
  630.     }
  631.     else {
  632.         arg->arg_type = O_SASSIGN;
  633.         goto sassign;
  634.     }
  635.     case O_LOCAL:
  636.       local:
  637.     arglast[2] = arglast[1];    /* push a null array */
  638.     /* FALL THROUGH */
  639.     case O_AASSIGN:
  640.       aassign:
  641.     sp = do_assign(arg,
  642.       gimme,arglast);
  643.     goto array_return;
  644.     case O_SASSIGN:
  645.       sassign:
  646. #ifdef TAINT
  647.     if (tainted && !st[2]->str_tainted)
  648.         tainted = 0;
  649. #endif
  650.     STR_SSET(str, st[2]);
  651.     STABSET(str);
  652.     break;
  653.     case O_CHOP:
  654.     st -= arglast[0];
  655.     str = arg->arg_ptr.arg_str;
  656.     for (sp = arglast[0] + 1; sp <= arglast[1]; sp++)
  657.         do_chop(str,st[sp]);
  658.     st += arglast[0];
  659.     break;
  660.     case O_DEFINED:
  661.     if (arg[1].arg_type & A_DONT) {
  662.         sp = do_defined(str,arg,
  663.           gimme,arglast);
  664.         goto array_return;
  665.     }
  666.     else if (str->str_pok || str->str_nok)
  667.         goto say_yes;
  668.     goto say_no;
  669.     case O_UNDEF:
  670.     if (arg[1].arg_type & A_DONT) {
  671.         sp = do_undef(str,arg,
  672.           gimme,arglast);
  673.         goto array_return;
  674.     }
  675.     else if (str != stab_val(defstab)) {
  676.         if (str->str_len) {
  677.         if (str->str_state == SS_INCR)
  678.             Str_Grow(str,0);
  679.         Safefree(str->str_ptr);
  680.         str->str_ptr = Nullch;
  681.         str->str_len = 0;
  682.         }
  683.         str->str_pok = str->str_nok = 0;
  684.         STABSET(str);
  685.     }
  686.     goto say_undef;
  687.     case O_STUDY:
  688.     sp = do_study(str,arg,
  689.       gimme,arglast);
  690.     goto array_return;
  691.     case O_POW:
  692.     value = str_gnum(st[1]);
  693.     value = pow(value,str_gnum(st[2]));
  694.     goto donumset;
  695.     case O_MULTIPLY:
  696.     value = str_gnum(st[1]);
  697.     value *= str_gnum(st[2]);
  698.     goto donumset;
  699.     case O_DIVIDE:
  700.     if ((value = str_gnum(st[2])) == 0.0)
  701.         fatal("Illegal division by zero");
  702. #ifdef cray
  703.     /* insure that 20./5. == 4. */
  704.     {
  705.         double x;
  706.         int    k;
  707.         x =  str_gnum(st[1]);
  708.         if ((double)(int)x     == x &&
  709.         (double)(int)value == value &&
  710.         (k = (int)x/(int)value)*(int)value == (int)x) {
  711.         value = k;
  712.         } else {
  713.         value = x/value;
  714.         }
  715.     }
  716. #else
  717.     value = str_gnum(st[1]) / value;
  718. #endif
  719.     goto donumset;
  720.     case O_MODULO:
  721.     tmplong = (long) str_gnum(st[2]);
  722.         if (tmplong == 0L)
  723.             fatal("Illegal modulus zero");
  724.     when = (long)str_gnum(st[1]);
  725. #ifndef lint
  726.     if (when >= 0)
  727.         value = (double)(when % tmplong);
  728.     else
  729.         value = (double)(tmplong - ((-when - 1) % tmplong)) - 1;
  730. #endif
  731.     goto donumset;
  732.     case O_ADD:
  733.     value = str_gnum(st[1]);
  734.     value += str_gnum(st[2]);
  735.     goto donumset;
  736.     case O_SUBTRACT:
  737.     value = str_gnum(st[1]);
  738.     value -= str_gnum(st[2]);
  739.     goto donumset;
  740.     case O_LEFT_SHIFT:
  741.     value = str_gnum(st[1]);
  742.     anum = (int)str_gnum(st[2]);
  743. #ifndef lint
  744.     value = (double)(U_L(value) << anum);
  745. #endif
  746.     goto donumset;
  747.     case O_RIGHT_SHIFT:
  748.     value = str_gnum(st[1]);
  749.     anum = (int)str_gnum(st[2]);
  750. #ifndef lint
  751.     value = (double)(U_L(value) >> anum);
  752. #endif
  753.     goto donumset;
  754.     case O_LT:
  755.     value = str_gnum(st[1]);
  756.     value = (value < str_gnum(st[2])) ? 1.0 : 0.0;
  757.     goto donumset;
  758.     case O_GT:
  759.     value = str_gnum(st[1]);
  760.     value = (value > str_gnum(st[2])) ? 1.0 : 0.0;
  761.     goto donumset;
  762.     case O_LE:
  763.     value = str_gnum(st[1]);
  764.     value = (value <= str_gnum(st[2])) ? 1.0 : 0.0;
  765.     goto donumset;
  766.     case O_GE:
  767.     value = str_gnum(st[1]);
  768.     value = (value >= str_gnum(st[2])) ? 1.0 : 0.0;
  769.     goto donumset;
  770.     case O_EQ:
  771.     if (dowarn) {
  772.         if ((!st[1]->str_nok && !looks_like_number(st[1])) ||
  773.         (!st[2]->str_nok && !looks_like_number(st[2])) )
  774.         warn("Possible use of == on string value");
  775.     }
  776.     value = str_gnum(st[1]);
  777.     value = (value == str_gnum(st[2])) ? 1.0 : 0.0;
  778.     goto donumset;
  779.     case O_NE:
  780.     value = str_gnum(st[1]);
  781.     value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
  782.     goto donumset;
  783.     case O_NCMP:
  784.     value = str_gnum(st[1]);
  785.     value -= str_gnum(st[2]);
  786.     if (value > 0.0)
  787.         value = 1.0;
  788.     else if (value < 0.0)
  789.         value = -1.0;
  790.     goto donumset;
  791.     case O_BIT_AND:
  792.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  793.         value = str_gnum(st[1]);
  794. #ifndef lint
  795.         value = (double)(U_L(value) & U_L(str_gnum(st[2])));
  796. #endif
  797.         goto donumset;
  798.     }
  799.     else
  800.         do_vop(optype,str,st[1],st[2]);
  801.     break;
  802.     case O_XOR:
  803.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  804.         value = str_gnum(st[1]);
  805. #ifndef lint
  806.         value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
  807. #endif
  808.         goto donumset;
  809.     }
  810.     else
  811.         do_vop(optype,str,st[1],st[2]);
  812.     break;
  813.     case O_BIT_OR:
  814.     if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
  815.         value = str_gnum(st[1]);
  816. #ifndef lint
  817.         value = (double)(U_L(value) | U_L(str_gnum(st[2])));
  818. #endif
  819.         goto donumset;
  820.     }
  821.     else
  822.         do_vop(optype,str,st[1],st[2]);
  823.     break;
  824. /* use register in evaluating str_true() */
  825.     case O_AND:
  826.     if (str_true(st[1])) {
  827.         anum = 2;
  828.         optype = O_ITEM2;
  829.         argflags = arg[anum].arg_flags;
  830.         if (gimme == G_ARRAY)
  831.         argflags |= AF_ARYOK;
  832.         argtype = arg[anum].arg_type & A_MASK;
  833.         argptr = arg[anum].arg_ptr;
  834.         maxarg = anum = 1;
  835.         sp = arglast[0];
  836.         st -= sp;
  837.         goto re_eval;
  838.     }
  839.     else {
  840.         if (assigning) {
  841.         str_sset(str, st[1]);
  842.         STABSET(str);
  843.         }
  844.         else
  845.         str = st[1];
  846.         break;
  847.     }
  848.     case O_OR:
  849.     if (str_true(st[1])) {
  850.         if (assigning) {
  851.         str_sset(str, st[1]);
  852.         STABSET(str);
  853.         }
  854.         else
  855.         str = st[1];
  856.         break;
  857.     }
  858.     else {
  859.         anum = 2;
  860.         optype = O_ITEM2;
  861.         argflags = arg[anum].arg_flags;
  862.         if (gimme == G_ARRAY)
  863.         argflags |= AF_ARYOK;
  864.         argtype = arg[anum].arg_type & A_MASK;
  865.         argptr = arg[anum].arg_ptr;
  866.         maxarg = anum = 1;
  867.         sp = arglast[0];
  868.         st -= sp;
  869.         goto re_eval;
  870.     }
  871.     case O_COND_EXPR:
  872.     anum = (str_true(st[1]) ? 2 : 3);
  873.     optype = (anum == 2 ? O_ITEM2 : O_ITEM3);
  874.     argflags = arg[anum].arg_flags;
  875.     if (gimme == G_ARRAY)
  876.         argflags |= AF_ARYOK;
  877.     argtype = arg[anum].arg_type & A_MASK;
  878.     argptr = arg[anum].arg_ptr;
  879.     maxarg = anum = 1;
  880.     sp = arglast[0];
  881.     st -= sp;
  882.     goto re_eval;
  883.     case O_COMMA:
  884.     if (gimme == G_ARRAY)
  885.         goto array_return;
  886.     str = st[2];
  887.     break;
  888.     case O_NEGATE:
  889.     value = -str_gnum(st[1]);
  890.     goto donumset;
  891.     case O_NOT:
  892.     value = (double) !str_true(st[1]);
  893.     goto donumset;
  894.     case O_COMPLEMENT:
  895.     if (!sawvec || st[1]->str_nok) {
  896. #ifndef lint
  897.         value = (double) ~U_L(str_gnum(st[1]));
  898. #endif
  899.         goto donumset;
  900.     }
  901.     else {
  902.         STR_SSET(str,st[1]);
  903.         tmps = str_get(str);
  904.         for (anum = str->str_cur; anum; anum--, tmps++)
  905.         *tmps = ~*tmps;
  906.     }
  907.     break;
  908.     case O_SELECT:
  909.     stab_fullname(str,defoutstab);
  910.     if (maxarg > 0) {
  911.         if ((arg[1].arg_type & A_MASK) == A_WORD)
  912.         defoutstab = arg[1].arg_ptr.arg_stab;
  913.         else
  914.         defoutstab = stabent(str_get(st[1]),TRUE);
  915.         if (!stab_io(defoutstab))
  916.         stab_io(defoutstab) = stio_new();
  917.         curoutstab = defoutstab;
  918.     }
  919.     STABSET(str);
  920.     break;
  921.     case O_WRITE:
  922.     if (maxarg == 0)
  923.         stab = defoutstab;
  924.     else if ((arg[1].arg_type & A_MASK) == A_WORD) {
  925.         if (!(stab = arg[1].arg_ptr.arg_stab))
  926.         stab = defoutstab;
  927.     }
  928.     else
  929.         stab = stabent(str_get(st[1]),TRUE);
  930.     if (!stab_io(stab)) {
  931.         str_set(str, No);
  932.         STABSET(str);
  933.         break;
  934.     }
  935.     curoutstab = stab;
  936.     fp = stab_io(stab)->ofp;
  937.     debarg = arg;
  938.     if (stab_io(stab)->fmt_stab)
  939.         form = stab_form(stab_io(stab)->fmt_stab);
  940.     else
  941.         form = stab_form(stab);
  942.     if (!form || !fp) {
  943.         if (dowarn) {
  944.         if (form)
  945.             warn("No format for filehandle");
  946.         else {
  947.             if (stab_io(stab)->ifp)
  948.             warn("Filehandle only opened for input");
  949.             else
  950.             warn("Write on closed filehandle");
  951.         }
  952.         }
  953.         str_set(str, No);
  954.         STABSET(str);
  955.         break;
  956.     }
  957.     format(&outrec,form,sp);
  958.     do_write(&outrec,stab,sp);
  959.     if (stab_io(stab)->flags & IOF_FLUSH)
  960.         (void)fflush(fp);
  961.     str_set(str, Yes);
  962.     STABSET(str);
  963.     break;
  964.     case O_DBMOPEN:
  965. #ifdef SOME_DBM
  966.     anum = arg[1].arg_type & A_MASK;
  967.     if (anum == A_WORD || anum == A_STAB)
  968.         stab = arg[1].arg_ptr.arg_stab;
  969.     else
  970.         stab = stabent(str_get(st[1]),TRUE);
  971.     if (st[3]->str_nok || st[3]->str_pok)
  972.         anum = (int)str_gnum(st[3]);
  973.     else
  974.         anum = -1;
  975.     value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
  976.     goto donumset;
  977. #else
  978.     fatal("No dbm or ndbm on this machine");
  979. #endif
  980.     case O_DBMCLOSE:
  981. #ifdef SOME_DBM
  982.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  983.         stab = arg[1].arg_ptr.arg_stab;
  984.     else
  985.         stab = stabent(str_get(st[1]),TRUE);
  986.     hdbmclose(stab_hash(stab));
  987.     goto say_yes;
  988. #else
  989.     fatal("No dbm or ndbm on this machine");
  990. #endif
  991.     case O_OPEN:
  992.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  993.         stab = arg[1].arg_ptr.arg_stab;
  994.     else
  995.         stab = stabent(str_get(st[1]),TRUE);
  996.     tmps = str_get(st[2]);
  997.     if (do_open(stab,tmps,st[2]->str_cur)) {
  998.         value = (double)forkprocess;
  999.         stab_io(stab)->lines = 0;
  1000.         goto donumset;
  1001.     }
  1002.     else if (forkprocess == 0)        /* we are a new child */
  1003.         goto say_zero;
  1004.     else
  1005.         goto say_undef;
  1006.     /* break; */
  1007.     case O_TRANS:
  1008.     value = (double) do_trans(str,arg);
  1009.     str = arg->arg_ptr.arg_str;
  1010.     goto donumset;
  1011.     case O_NTRANS:
  1012.     str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No);
  1013.     str = arg->arg_ptr.arg_str;
  1014.     break;
  1015.     case O_CLOSE:
  1016.     if (maxarg == 0)
  1017.         stab = defoutstab;
  1018.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1019.         stab = arg[1].arg_ptr.arg_stab;
  1020.     else
  1021.         stab = stabent(str_get(st[1]),TRUE);
  1022.     str_set(str, do_close(stab,TRUE) ? Yes : No );
  1023.     STABSET(str);
  1024.     break;
  1025.     case O_EACH:
  1026.     sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab),
  1027.       gimme,arglast);
  1028.     goto array_return;
  1029.     case O_VALUES:
  1030.     case O_KEYS:
  1031.     sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  1032.       gimme,arglast);
  1033.     goto array_return;
  1034.     case O_LARRAY:
  1035.     str->str_nok = str->str_pok = 0;
  1036.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  1037.     str->str_state = SS_ARY;
  1038.     break;
  1039.     case O_ARRAY:
  1040.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  1041.     maxarg = ary->ary_fill + 1;
  1042.     if (gimme == G_ARRAY) { /* array wanted */
  1043.         sp = arglast[0];
  1044.         st -= sp;
  1045.         if (maxarg > 0 && sp + maxarg > stack->ary_max) {
  1046.         astore(stack,sp + maxarg, Nullstr);
  1047.         st = stack->ary_array;
  1048.         }
  1049.         st += sp;
  1050.         Copy(ary->ary_array, &st[1], maxarg, STR*);
  1051.         sp += maxarg;
  1052.         goto array_return;
  1053.     }
  1054.     else {
  1055.         value = (double)maxarg;
  1056.         goto donumset;
  1057.     }
  1058.     case O_AELEM:
  1059.     anum = ((int)str_gnum(st[2])) - arybase;
  1060.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
  1061.     break;
  1062.     case O_DELETE:
  1063.     tmpstab = arg[1].arg_ptr.arg_stab;
  1064.     tmps = str_get(st[2]);
  1065.     str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur);
  1066.     if (tmpstab == envstab)
  1067.         setenv(tmps,Nullch);
  1068.     if (!str)
  1069.         goto say_undef;
  1070.     break;
  1071.     case O_LHASH:
  1072.     str->str_nok = str->str_pok = 0;
  1073.     str->str_u.str_stab = arg[1].arg_ptr.arg_stab;
  1074.     str->str_state = SS_HASH;
  1075.     break;
  1076.     case O_HASH:
  1077.     if (gimme == G_ARRAY) { /* array wanted */
  1078.         sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype,
  1079.         gimme,arglast);
  1080.         goto array_return;
  1081.     }
  1082.     else {
  1083.         tmpstab = arg[1].arg_ptr.arg_stab;
  1084.         if (!stab_hash(tmpstab)->tbl_fill)
  1085.         goto say_zero;
  1086.         sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
  1087.         stab_hash(tmpstab)->tbl_max+1);
  1088.         str_set(str,buf);
  1089.     }
  1090.     break;
  1091.     case O_HELEM:
  1092.     tmpstab = arg[1].arg_ptr.arg_stab;
  1093.     tmps = str_get(st[2]);
  1094.     str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
  1095.     break;
  1096.     case O_LAELEM:
  1097.     anum = ((int)str_gnum(st[2])) - arybase;
  1098.     str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
  1099.     if (!str || str == &str_undef)
  1100.         fatal("Assignment to non-creatable value, subscript %d",anum);
  1101.     break;
  1102.     case O_LHELEM:
  1103.     tmpstab = arg[1].arg_ptr.arg_stab;
  1104.     tmps = str_get(st[2]);
  1105.     anum = st[2]->str_cur;
  1106.     str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
  1107.     if (!str || str == &str_undef)
  1108.         fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
  1109.     if (tmpstab == envstab)        /* heavy wizardry going on here */
  1110.         str_magic(str, tmpstab, 'E', tmps, anum);    /* str is now magic */
  1111.                     /* he threw the brick up into the air */
  1112.     else if (tmpstab == sigstab)
  1113.         str_magic(str, tmpstab, 'S', tmps, anum);
  1114. #ifdef SOME_DBM
  1115.     else if (stab_hash(tmpstab)->tbl_dbm)
  1116.         str_magic(str, tmpstab, 'D', tmps, anum);
  1117. #endif
  1118.     else if (tmpstab == DBline)
  1119.         str_magic(str, tmpstab, 'L', tmps, anum);
  1120.     break;
  1121.     case O_LSLICE:
  1122.     anum = 2;
  1123.     argtype = FALSE;
  1124.     goto do_slice_already;
  1125.     case O_ASLICE:
  1126.     anum = 1;
  1127.     argtype = FALSE;
  1128.     goto do_slice_already;
  1129.     case O_HSLICE:
  1130.     anum = 0;
  1131.     argtype = FALSE;
  1132.     goto do_slice_already;
  1133.     case O_LASLICE:
  1134.     anum = 1;
  1135.     argtype = TRUE;
  1136.     goto do_slice_already;
  1137.     case O_LHSLICE:
  1138.     anum = 0;
  1139.     argtype = TRUE;
  1140.       do_slice_already:
  1141.     sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype,
  1142.         gimme,arglast);
  1143.     goto array_return;
  1144.     case O_SPLICE:
  1145.     sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
  1146.     goto array_return;
  1147.     case O_PUSH:
  1148.     if (arglast[2] - arglast[1] != 1)
  1149.         str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast);
  1150.     else {
  1151.         str = Str_new(51,0);        /* must copy the STR */
  1152.         str_sset(str,st[2]);
  1153.         (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str);
  1154.     }
  1155.     break;
  1156.     case O_POP:
  1157.     str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab));
  1158.     goto staticalization;
  1159.     case O_SHIFT:
  1160.     str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab));
  1161.       staticalization:
  1162.     if (!str)
  1163.         goto say_undef;
  1164.     if (ary->ary_flags & ARF_REAL)
  1165.         (void)str_2mortal(str);
  1166.     break;
  1167.     case O_UNPACK:
  1168.     sp = do_unpack(str,gimme,arglast);
  1169.     goto array_return;
  1170.     case O_SPLIT:
  1171.     value = str_gnum(st[3]);
  1172.     sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value,
  1173.       gimme,arglast);
  1174.     goto array_return;
  1175.     case O_LENGTH:
  1176.     if (maxarg < 1)
  1177.         value = (double)str_len(stab_val(defstab));
  1178.     else
  1179.         value = (double)str_len(st[1]);
  1180.     goto donumset;
  1181.     case O_SPRINTF:
  1182.     do_sprintf(str, sp-arglast[0], st+1);
  1183.     break;
  1184.     case O_SUBSTR:
  1185.     anum = ((int)str_gnum(st[2])) - arybase;    /* anum=where to start*/
  1186.     tmps = str_get(st[1]);        /* force conversion to string */
  1187.     if (argtype = (str == st[1]))
  1188.         str = arg->arg_ptr.arg_str;
  1189.     if (anum < 0)
  1190.         anum += st[1]->str_cur + arybase;
  1191.     if (anum < 0 || anum > st[1]->str_cur)
  1192.         str_nset(str,"",0);
  1193.     else {
  1194.         optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
  1195.         if (optype < 0)
  1196.         optype = 0;
  1197.         tmps += anum;
  1198.         anum = st[1]->str_cur - anum;    /* anum=how many bytes left*/
  1199.         if (anum > optype)
  1200.         anum = optype;
  1201.         str_nset(str, tmps, anum);
  1202.         if (argtype) {            /* it's an lvalue! */
  1203.         lstr = (struct lstring*)str;
  1204.         str->str_magic = st[1];
  1205.         st[1]->str_rare = 's';
  1206.         lstr->lstr_offset = tmps - str_get(st[1]);
  1207.         lstr->lstr_len = anum;
  1208.         }
  1209.     }
  1210.     break;
  1211.     case O_PACK:
  1212.     (void)do_pack(str,arglast);
  1213.     break;
  1214.     case O_GREP:
  1215.     sp = do_grep(arg,str,gimme,arglast);
  1216.     goto array_return;
  1217.     case O_JOIN:
  1218.     do_join(str,arglast);
  1219.     break;
  1220.     case O_SLT:
  1221.     tmps = str_get(st[1]);
  1222.     value = (double) (str_cmp(st[1],st[2]) < 0);
  1223.     goto donumset;
  1224.     case O_SGT:
  1225.     tmps = str_get(st[1]);
  1226.     value = (double) (str_cmp(st[1],st[2]) > 0);
  1227.     goto donumset;
  1228.     case O_SLE:
  1229.     tmps = str_get(st[1]);
  1230.     value = (double) (str_cmp(st[1],st[2]) <= 0);
  1231.     goto donumset;
  1232.     case O_SGE:
  1233.     tmps = str_get(st[1]);
  1234.     value = (double) (str_cmp(st[1],st[2]) >= 0);
  1235.     goto donumset;
  1236.     case O_SEQ:
  1237.     tmps = str_get(st[1]);
  1238.     value = (double) str_eq(st[1],st[2]);
  1239.     goto donumset;
  1240.     case O_SNE:
  1241.     tmps = str_get(st[1]);
  1242.     value = (double) !str_eq(st[1],st[2]);
  1243.     goto donumset;
  1244.     case O_SCMP:
  1245.     tmps = str_get(st[1]);
  1246.     value = (double) str_cmp(st[1],st[2]);
  1247.     goto donumset;
  1248.     case O_SUBR:
  1249.     sp = do_subr(arg,gimme,arglast);
  1250.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1251.     goto array_return;
  1252.     case O_DBSUBR:
  1253.     sp = do_subr(arg,gimme,arglast);
  1254.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1255.     goto array_return;
  1256.     case O_CALLER:
  1257.     sp = do_caller(arg,maxarg,gimme,arglast);
  1258.     st = stack->ary_array + arglast[0];        /* maybe realloced */
  1259.     goto array_return;
  1260.     case O_SORT:
  1261.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1262.         stab = arg[1].arg_ptr.arg_stab;
  1263.     else
  1264.         stab = stabent(str_get(st[1]),TRUE);
  1265.     sp = do_sort(str,stab,
  1266.       gimme,arglast);
  1267.     goto array_return;
  1268.     case O_REVERSE:
  1269.     if (gimme == G_ARRAY)
  1270.         sp = do_reverse(arglast);
  1271.     else
  1272.         sp = do_sreverse(str, arglast);
  1273.     goto array_return;
  1274.     case O_WARN:
  1275.     if (arglast[2] - arglast[1] != 1) {
  1276.         do_join(str,arglast);
  1277.         tmps = str_get(str);
  1278.     }
  1279.     else {
  1280.         str = st[2];
  1281.         tmps = str_get(st[2]);
  1282.     }
  1283.     if (!tmps || !*tmps)
  1284.         tmps = "Warning: something's wrong";
  1285.     warn("%s",tmps);
  1286.     goto say_yes;
  1287.     case O_DIE:
  1288.     if (arglast[2] - arglast[1] != 1) {
  1289.         do_join(str,arglast);
  1290.         tmps = str_get(str);
  1291.     }
  1292.     else {
  1293.         str = st[2];
  1294.         tmps = str_get(st[2]);
  1295.     }
  1296.     if (!tmps || !*tmps)
  1297.         tmps = "Died";
  1298.     fatal("%s",tmps);
  1299.     goto say_zero;
  1300.     case O_PRTF:
  1301.     case O_PRINT:
  1302.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1303.         stab = arg[1].arg_ptr.arg_stab;
  1304.     else
  1305.         stab = stabent(str_get(st[1]),TRUE);
  1306.     if (!stab)
  1307.         stab = defoutstab;
  1308.     if (!stab_io(stab)) {
  1309.         if (dowarn)
  1310.         warn("Filehandle never opened");
  1311.         goto say_zero;
  1312.     }
  1313.     if (!(fp = stab_io(stab)->ofp)) {
  1314.         if (dowarn)  {
  1315.         if (stab_io(stab)->ifp)
  1316.             warn("Filehandle opened only for input");
  1317.         else
  1318.             warn("Print on closed filehandle");
  1319.         }
  1320.         goto say_zero;
  1321.     }
  1322.     else {
  1323.         if (optype == O_PRTF || arglast[2] - arglast[1] != 1)
  1324.         value = (double)do_aprint(arg,fp,arglast);
  1325.         else {
  1326.         value = (double)do_print(st[2],fp);
  1327.         if (orslen && optype == O_PRINT)
  1328.             if (fwrite(ors, 1, orslen, fp) == 0)
  1329.             goto say_zero;
  1330.         }
  1331.         if (stab_io(stab)->flags & IOF_FLUSH)
  1332.         if (fflush(fp) == EOF)
  1333.             goto say_zero;
  1334.     }
  1335.     goto donumset;
  1336.     case O_CHDIR:
  1337.     if (maxarg < 1)
  1338.         tmps = Nullch;
  1339.     else
  1340.         tmps = str_get(st[1]);
  1341.     if (!tmps || !*tmps) {
  1342.         tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
  1343.         tmps = str_get(tmpstr);
  1344.     }
  1345.     if (!tmps || !*tmps) {
  1346.         tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
  1347.         tmps = str_get(tmpstr);
  1348.     }
  1349. #ifdef TAINT
  1350.     taintproper("Insecure dependency in chdir");
  1351. #endif
  1352.     value = (double)(chdir(tmps) >= 0);
  1353.     goto donumset;
  1354.     case O_EXIT:
  1355.     if (maxarg < 1)
  1356.         anum = 0;
  1357.     else
  1358.         anum = (int)str_gnum(st[1]);
  1359.     exit(anum);
  1360.     goto say_zero;
  1361.     case O_RESET:
  1362.     if (maxarg < 1)
  1363.         tmps = "";
  1364.     else
  1365.         tmps = str_get(st[1]);
  1366.     str_reset(tmps,curcmd->c_stash);
  1367.     value = 1.0;
  1368.     goto donumset;
  1369.     case O_LIST:
  1370.     if (gimme == G_ARRAY)
  1371.         goto array_return;
  1372.     if (maxarg > 0)
  1373.         str = st[sp - arglast[0]];    /* unwanted list, return last item */
  1374.     else
  1375.         str = &str_undef;
  1376.     break;
  1377.     case O_EOF:
  1378.     if (maxarg <= 0)
  1379.         stab = last_in_stab;
  1380.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1381.         stab = arg[1].arg_ptr.arg_stab;
  1382.     else
  1383.         stab = stabent(str_get(st[1]),TRUE);
  1384.     str_set(str, do_eof(stab) ? Yes : No);
  1385.     STABSET(str);
  1386.     break;
  1387.     case O_GETC:
  1388.     if (maxarg <= 0)
  1389.         stab = stdinstab;
  1390.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1391.         stab = arg[1].arg_ptr.arg_stab;
  1392.     else
  1393.         stab = stabent(str_get(st[1]),TRUE);
  1394.     if (!stab)
  1395.         stab = argvstab;
  1396.     if (!stab || do_eof(stab)) /* make sure we have fp with something */
  1397.         goto say_undef;
  1398.     else {
  1399. #ifdef TAINT
  1400.         tainted = 1;
  1401. #endif
  1402.         str_set(str," ");
  1403.         *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */
  1404.     }
  1405.     STABSET(str);
  1406.     break;
  1407.     case O_TELL:
  1408.     if (maxarg <= 0)
  1409.         stab = last_in_stab;
  1410.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  1411.         stab = arg[1].arg_ptr.arg_stab;
  1412.     else
  1413.         stab = stabent(str_get(st[1]),TRUE);
  1414. #ifndef lint
  1415.     value = (double)do_tell(stab);
  1416. #else
  1417.     (void)do_tell(stab);
  1418. #endif
  1419.     goto donumset;
  1420.     case O_RECV:
  1421.     case O_READ:
  1422.     case O_SYSREAD:
  1423.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1424.         stab = arg[1].arg_ptr.arg_stab;
  1425.     else
  1426.         stab = stabent(str_get(st[1]),TRUE);
  1427.     tmps = str_get(st[2]);
  1428.     anum = (int)str_gnum(st[3]);
  1429.     errno = 0;
  1430.     maxarg = sp - arglast[0];
  1431.     if (maxarg > 4)
  1432.         warn("Too many args on read");
  1433.     if (maxarg == 4)
  1434.         maxarg = (int)str_gnum(st[4]);
  1435.     else
  1436.         maxarg = 0;
  1437.     if (!stab_io(stab) || !stab_io(stab)->ifp)
  1438.         goto say_undef;
  1439. #ifdef HAS_SOCKET
  1440.     if (optype == O_RECV) {
  1441.         argtype = sizeof buf;
  1442.         STR_GROW(st[2], anum+1), (tmps = str_get(st[2]));  /* sneaky */
  1443.         anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg,
  1444.         buf, &argtype);
  1445.         if (anum >= 0) {
  1446.         st[2]->str_cur = anum;
  1447.         st[2]->str_ptr[anum] = '\0';
  1448.         str_nset(str,buf,argtype);
  1449.         }
  1450.         else
  1451.         str_sset(str,&str_undef);
  1452.         break;
  1453.     }
  1454. #else
  1455.     if (optype == O_RECV)
  1456.         goto badsock;
  1457. #endif
  1458.     STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
  1459. #ifdef HAS_SOCKET
  1460.     if (stab_io(stab)->type == 's') {
  1461.         argtype = sizeof buf;
  1462.         anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0,
  1463.         buf, &argtype);
  1464.     }
  1465.     else
  1466. #endif
  1467.     if (optype == O_SYSREAD) {
  1468.         anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
  1469.     }
  1470.     else
  1471.         anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
  1472.     if (anum < 0)
  1473.         goto say_undef;
  1474.     st[2]->str_cur = anum+maxarg;
  1475.     st[2]->str_ptr[anum+maxarg] = '\0';
  1476.     value = (double)anum;
  1477.     goto donumset;
  1478.     case O_SYSWRITE:
  1479.     case O_SEND:
  1480.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1481.         stab = arg[1].arg_ptr.arg_stab;
  1482.     else
  1483.         stab = stabent(str_get(st[1]),TRUE);
  1484.     tmps = str_get(st[2]);
  1485.     anum = (int)str_gnum(st[3]);
  1486.     errno = 0;
  1487.     stio = stab_io(stab);
  1488.     maxarg = sp - arglast[0];
  1489.     if (!stio || !stio->ifp) {
  1490.         anum = -1;
  1491.         if (dowarn) {
  1492.         if (optype == O_SYSWRITE)
  1493.             warn("Syswrite on closed filehandle");
  1494.         else
  1495.             warn("Send on closed socket");
  1496.         }
  1497.     }
  1498.     else if (optype == O_SYSWRITE) {
  1499.         if (maxarg > 4)
  1500.         warn("Too many args on syswrite");
  1501.         if (maxarg == 4)
  1502.         optype = (int)str_gnum(st[4]);
  1503.         else
  1504.         optype = 0;
  1505.         anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
  1506.     }
  1507. #ifdef HAS_SOCKET
  1508.     else if (maxarg >= 4) {
  1509.         if (maxarg > 4)
  1510.         warn("Too many args on send");
  1511.         tmps2 = str_get(st[4]);
  1512.         anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
  1513.           anum, tmps2, st[4]->str_cur);
  1514.     }
  1515.     else
  1516.         anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
  1517. #else
  1518.     else
  1519.         goto badsock;
  1520. #endif
  1521.     if (anum < 0)
  1522.         goto say_undef;
  1523.     value = (double)anum;
  1524.     goto donumset;
  1525.     case O_SEEK:
  1526.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1527.         stab = arg[1].arg_ptr.arg_stab;
  1528.     else
  1529.         stab = stabent(str_get(st[1]),TRUE);
  1530.     value = str_gnum(st[2]);
  1531.     str_set(str, do_seek(stab,
  1532.       (long)value, (int)str_gnum(st[3]) ) ? Yes : No);
  1533.     STABSET(str);
  1534.     break;
  1535.     case O_RETURN:
  1536.     tmps = "_SUB_";        /* just fake up a "last _SUB_" */
  1537.     optype = O_LAST;
  1538.     if (curcsv && curcsv->wantarray == G_ARRAY) {
  1539.         lastretstr = Nullstr;
  1540.         lastspbase = arglast[1];
  1541.         lastsize = arglast[2] - arglast[1];
  1542.     }
  1543.     else
  1544.         lastretstr = str_mortal(st[arglast[2] - arglast[0]]);
  1545.     goto dopop;
  1546.     case O_REDO:
  1547.     case O_NEXT:
  1548.     case O_LAST:
  1549.     if (maxarg > 0) {
  1550.         tmps = str_get(arg[1].arg_ptr.arg_str);
  1551.       dopop:
  1552.         while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
  1553.           strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
  1554. #ifdef DEBUGGING
  1555.         if (debug & 4) {
  1556.             deb("(Skipping label #%d %s)\n",loop_ptr,
  1557.             loop_stack[loop_ptr].loop_label);
  1558.         }
  1559. #endif
  1560.         loop_ptr--;
  1561.         }
  1562. #ifdef DEBUGGING
  1563.         if (debug & 4) {
  1564.         deb("(Found label #%d %s)\n",loop_ptr,
  1565.             loop_stack[loop_ptr].loop_label);
  1566.         }
  1567. #endif
  1568.     }
  1569.     if (loop_ptr < 0) {
  1570.         if (tmps && strEQ(tmps, "_SUB_"))
  1571.         fatal("Can't return outside a subroutine");
  1572.         fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
  1573.     }
  1574.     if (!lastretstr && optype == O_LAST && lastsize) {
  1575.         st -= arglast[0];
  1576.         st += lastspbase + 1;
  1577.         optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */
  1578.         if (optype) {
  1579.         for (anum = lastsize; anum > 0; anum--,st++)
  1580.             st[optype] = str_mortal(st[0]);
  1581.         }
  1582.         longjmp(loop_stack[loop_ptr].loop_env, O_LAST);
  1583.     }
  1584.     longjmp(loop_stack[loop_ptr].loop_env, optype);
  1585.     case O_DUMP:
  1586.     case O_GOTO:/* shudder */
  1587.     goto_targ = str_get(arg[1].arg_ptr.arg_str);
  1588.     if (!*goto_targ)
  1589.         goto_targ = Nullch;        /* just restart from top */
  1590.     if (optype == O_DUMP) {
  1591.         do_undump = 1;
  1592.         my_unexec();
  1593.     }
  1594.     longjmp(top_env, 1);
  1595.     case O_INDEX:
  1596.     tmps = str_get(st[1]);
  1597.     if (maxarg < 3)
  1598.         anum = 0;
  1599.     else {
  1600.         anum = (int) str_gnum(st[3]) - arybase;
  1601.         if (anum < 0)
  1602.         anum = 0;
  1603.         else if (anum > st[1]->str_cur)
  1604.         anum = st[1]->str_cur;
  1605.     }
  1606. #ifndef lint
  1607.     if (!(tmps2 = fbminstr((unsigned char*)tmps + anum,
  1608.       (unsigned char*)tmps + st[1]->str_cur, st[2])))
  1609. #else
  1610.     if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
  1611. #endif
  1612.         value = (double)(-1 + arybase);
  1613.     else
  1614.         value = (double)(tmps2 - tmps + arybase);
  1615.     goto donumset;
  1616.     case O_RINDEX:
  1617.     tmps = str_get(st[1]);
  1618.     tmps2 = str_get(st[2]);
  1619.     if (maxarg < 3)
  1620.         anum = st[1]->str_cur;
  1621.     else {
  1622.         anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
  1623.         if (anum < 0)
  1624.         anum = 0;
  1625.         else if (anum > st[1]->str_cur)
  1626.         anum = st[1]->str_cur;
  1627.     }
  1628. #ifndef lint
  1629.     if (!(tmps2 = rninstr(tmps,  tmps  + anum,
  1630.                   tmps2, tmps2 + st[2]->str_cur)))
  1631. #else
  1632.     if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
  1633. #endif
  1634.         value = (double)(-1 + arybase);
  1635.     else
  1636.         value = (double)(tmps2 - tmps + arybase);
  1637.     goto donumset;
  1638.     case O_TIME:
  1639. #ifndef lint
  1640.     value = (double) time(Null(long*));
  1641. #endif
  1642.     goto donumset;
  1643.     case O_TMS:
  1644.     sp = do_tms(str,gimme,arglast);
  1645.     goto array_return;
  1646.     case O_LOCALTIME:
  1647.     if (maxarg < 1)
  1648.         (void)time(&when);
  1649.     else
  1650.         when = (long)str_gnum(st[1]);
  1651.     sp = do_time(str,localtime(&when),
  1652.       gimme,arglast);
  1653.     goto array_return;
  1654.     case O_GMTIME:
  1655.     if (maxarg < 1)
  1656.         (void)time(&when);
  1657.     else
  1658.         when = (long)str_gnum(st[1]);
  1659.     sp = do_time(str,gmtime(&when),
  1660.       gimme,arglast);
  1661.     goto array_return;
  1662.     case O_TRUNCATE:
  1663.     sp = do_truncate(str,arg,
  1664.       gimme,arglast);
  1665.     goto array_return;
  1666.     case O_LSTAT:
  1667.     case O_STAT:
  1668.     sp = do_stat(str,arg,
  1669.       gimme,arglast);
  1670.     goto array_return;
  1671.     case O_CRYPT:
  1672. #ifdef HAS_CRYPT
  1673.     tmps = str_get(st[1]);
  1674. #ifdef FCRYPT
  1675.     str_set(str,fcrypt(tmps,str_get(st[2])));
  1676. #else
  1677.     str_set(str,crypt(tmps,str_get(st[2])));
  1678. #endif
  1679. #else
  1680.     fatal(
  1681.       "The crypt() function is unimplemented due to excessive paranoia.");
  1682. #endif
  1683.     break;
  1684.     case O_ATAN2:
  1685.     value = str_gnum(st[1]);
  1686.     value = atan2(value,str_gnum(st[2]));
  1687.     goto donumset;
  1688.     case O_SIN:
  1689.     if (maxarg < 1)
  1690.         value = str_gnum(stab_val(defstab));
  1691.     else
  1692.         value = str_gnum(st[1]);
  1693.     value = sin(value);
  1694.     goto donumset;
  1695.     case O_COS:
  1696.     if (maxarg < 1)
  1697.         value = str_gnum(stab_val(defstab));
  1698.     else
  1699.         value = str_gnum(st[1]);
  1700.     value = cos(value);
  1701.     goto donumset;
  1702.     case O_RAND:
  1703.     if (maxarg < 1)
  1704.         value = 1.0;
  1705.     else
  1706.         value = str_gnum(st[1]);
  1707.     if (value == 0.0)
  1708.         value = 1.0;
  1709. #if RANDBITS == 31
  1710.     value = rand() * value / 2147483648.0;
  1711. #else
  1712. #if RANDBITS == 16
  1713.     value = rand() * value / 65536.0;
  1714. #else
  1715. #if RANDBITS == 15
  1716.     value = rand() * value / 32768.0;
  1717. #else
  1718.     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
  1719. #endif
  1720. #endif
  1721. #endif
  1722.     goto donumset;
  1723.     case O_SRAND:
  1724.     if (maxarg < 1) {
  1725.         (void)time(&when);
  1726.         anum = when;
  1727.     }
  1728.     else
  1729.         anum = (int)str_gnum(st[1]);
  1730.     (void)srand(anum);
  1731.     goto say_yes;
  1732.     case O_EXP:
  1733.     if (maxarg < 1)
  1734.         value = str_gnum(stab_val(defstab));
  1735.     else
  1736.         value = str_gnum(st[1]);
  1737.     value = exp(value);
  1738.     goto donumset;
  1739.     case O_LOG:
  1740.     if (maxarg < 1)
  1741.         value = str_gnum(stab_val(defstab));
  1742.     else
  1743.         value = str_gnum(st[1]);
  1744.     if (value <= 0.0)
  1745.         fatal("Can't take log of %g\n", value);
  1746.     value = log(value);
  1747.     goto donumset;
  1748.     case O_SQRT:
  1749.     if (maxarg < 1)
  1750.         value = str_gnum(stab_val(defstab));
  1751.     else
  1752.         value = str_gnum(st[1]);
  1753.     if (value < 0.0)
  1754.         fatal("Can't take sqrt of %g\n", value);
  1755.     value = sqrt(value);
  1756.     goto donumset;
  1757.     case O_INT:
  1758.     if (maxarg < 1)
  1759.         value = str_gnum(stab_val(defstab));
  1760.     else
  1761.         value = str_gnum(st[1]);
  1762.     if (value >= 0.0)
  1763.         (void)modf(value,&value);
  1764.     else {
  1765.         (void)modf(-value,&value);
  1766.         value = -value;
  1767.     }
  1768.     goto donumset;
  1769.     case O_ORD:
  1770.     if (maxarg < 1)
  1771.         tmps = str_get(stab_val(defstab));
  1772.     else
  1773.         tmps = str_get(st[1]);
  1774. #ifndef I286
  1775.     value = (double) (*tmps & 255);
  1776. #else
  1777.     anum = (int) *tmps;
  1778.     value = (double) (anum & 255);
  1779. #endif
  1780.     goto donumset;
  1781.     case O_ALARM:
  1782. #ifdef HAS_ALARM
  1783.     if (maxarg < 1)
  1784.         tmps = str_get(stab_val(defstab));
  1785.     else
  1786.         tmps = str_get(st[1]);
  1787.     if (!tmps)
  1788.         tmps = "0";
  1789.     anum = alarm((unsigned int)atoi(tmps));
  1790.     if (anum < 0)
  1791.         goto say_undef;
  1792.     value = (double)anum;
  1793.     goto donumset;
  1794. #else
  1795.     fatal("Unsupported function alarm");
  1796.     break;
  1797. #endif
  1798.     case O_SLEEP:
  1799.     if (maxarg < 1)
  1800.         tmps = Nullch;
  1801.     else
  1802.         tmps = str_get(st[1]);
  1803.     (void)time(&when);
  1804.     if (!tmps || !*tmps)
  1805.         sleep((32767<<16)+32767);
  1806.     else
  1807.         sleep((unsigned int)atoi(tmps));
  1808. #ifndef lint
  1809.     value = (double)when;
  1810.     (void)time(&when);
  1811.     value = ((double)when) - value;
  1812. #endif
  1813.     goto donumset;
  1814.     case O_RANGE:
  1815.     sp = do_range(gimme,arglast);
  1816.     goto array_return;
  1817.     case O_F_OR_R:
  1818.     if (gimme == G_ARRAY) {        /* it's a range */
  1819.         /* can we optimize to constant array? */
  1820.         if ((arg[1].arg_type & A_MASK) == A_SINGLE &&
  1821.           (arg[2].arg_type & A_MASK) == A_SINGLE) {
  1822.         st[2] = arg[2].arg_ptr.arg_str;
  1823.         sp = do_range(gimme,arglast);
  1824.         st = stack->ary_array;
  1825.         maxarg = sp - arglast[0];
  1826.         str_free(arg[1].arg_ptr.arg_str);
  1827.         arg[1].arg_ptr.arg_str = Nullstr;
  1828.         str_free(arg[2].arg_ptr.arg_str);
  1829.         arg[2].arg_ptr.arg_str = Nullstr;
  1830.         arg->arg_type = O_ARRAY;
  1831.         arg[1].arg_type = A_STAB|A_DONT;
  1832.         arg->arg_len = 1;
  1833.         stab = arg[1].arg_ptr.arg_stab = aadd(genstab());
  1834.         ary = stab_array(stab);
  1835.         afill(ary,maxarg - 1);
  1836.         anum = maxarg;
  1837.         st += arglast[0]+1;
  1838.         while (maxarg-- > 0)
  1839.             ary->ary_array[maxarg] = str_smake(st[maxarg]);
  1840.         st -= arglast[0]+1;
  1841.         goto array_return;
  1842.         }
  1843.         arg->arg_type = optype = O_RANGE;
  1844.         maxarg = arg->arg_len = 2;
  1845.         anum = 2;
  1846.         arg[anum].arg_flags &= ~AF_ARYOK;
  1847.         argflags = arg[anum].arg_flags;
  1848.         argtype = arg[anum].arg_type & A_MASK;
  1849.         arg[anum].arg_type = argtype;
  1850.         argptr = arg[anum].arg_ptr;
  1851.         sp = arglast[0];
  1852.         st -= sp;
  1853.         sp++;
  1854.         goto re_eval;
  1855.     }
  1856.     arg->arg_type = O_FLIP;
  1857.     /* FALL THROUGH */
  1858.     case O_FLIP:
  1859.     if ((arg[1].arg_type & A_MASK) == A_SINGLE ?
  1860.       last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines
  1861.       :
  1862.       str_true(st[1]) ) {
  1863.         str_numset(str,0.0);
  1864.         anum = 2;
  1865.         arg->arg_type = optype = O_FLOP;
  1866.         arg[2].arg_type &= ~A_DONT;
  1867.         arg[1].arg_type |= A_DONT;
  1868.         argflags = arg[2].arg_flags;
  1869.         argtype = arg[2].arg_type & A_MASK;
  1870.         argptr = arg[2].arg_ptr;
  1871.         sp = arglast[0];
  1872.         st -= sp++;
  1873.         goto re_eval;
  1874.     }
  1875.     str_set(str,"");
  1876.     break;
  1877.     case O_FLOP:
  1878.     str_inc(str);
  1879.     if ((arg[2].arg_type & A_MASK) == A_SINGLE ?
  1880.       last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines
  1881.       :
  1882.       str_true(st[2]) ) {
  1883.         arg->arg_type = O_FLIP;
  1884.         arg[1].arg_type &= ~A_DONT;
  1885.         arg[2].arg_type |= A_DONT;
  1886.         str_cat(str,"E0");
  1887.     }
  1888.     break;
  1889.     case O_FORK:
  1890. #ifdef HAS_FORK
  1891.     anum = fork();
  1892.     if (anum < 0)
  1893.         goto say_undef;
  1894.     if (!anum) {
  1895.         if (tmpstab = stabent("$",allstabs))
  1896.         str_numset(STAB_STR(tmpstab),(double)getpid());
  1897.         hclear(pidstatus);    /* no kids, so don't wait for 'em */
  1898.     }
  1899.     value = (double)anum;
  1900.     goto donumset;
  1901. #else
  1902.     fatal("Unsupported function fork");
  1903.     break;
  1904. #endif
  1905.     case O_WAIT:
  1906. #ifdef HAS_WAIT
  1907. #ifndef lint
  1908.     anum = wait(&argflags);
  1909.     if (anum > 0)
  1910.         pidgone(anum,argflags);
  1911.     value = (double)anum;
  1912. #endif
  1913.     statusvalue = (unsigned short)argflags;
  1914.     goto donumset;
  1915. #else
  1916.     fatal("Unsupported function wait");
  1917.     break;
  1918. #endif
  1919.     case O_WAITPID:
  1920. #ifdef HAS_WAIT
  1921. #ifndef lint
  1922.     anum = (int)str_gnum(st[1]);
  1923.     optype = (int)str_gnum(st[2]);
  1924.     anum = wait4pid(anum, &argflags,optype);
  1925.     value = (double)anum;
  1926. #endif
  1927.     statusvalue = (unsigned short)argflags;
  1928.     goto donumset;
  1929. #else
  1930.     fatal("Unsupported function wait");
  1931.     break;
  1932. #endif
  1933.     case O_SYSTEM:
  1934. #ifdef HAS_FORK
  1935. #ifdef TAINT
  1936.     if (arglast[2] - arglast[1] == 1) {
  1937.         taintenv();
  1938.         tainted |= st[2]->str_tainted;
  1939.         taintproper("Insecure dependency in system");
  1940.     }
  1941. #endif
  1942.     while ((anum = vfork()) == -1) {
  1943.         if (errno != EAGAIN) {
  1944.         value = -1.0;
  1945.         goto donumset;
  1946.         }
  1947.         sleep(5);
  1948.     }
  1949.     if (anum > 0) {
  1950. #ifndef lint
  1951.         ihand = signal(SIGINT, SIG_IGN);
  1952.         qhand = signal(SIGQUIT, SIG_IGN);
  1953.         argtype = wait4pid(anum, &argflags, 0);
  1954. #else
  1955.         ihand = qhand = 0;
  1956. #endif
  1957.         (void)signal(SIGINT, ihand);
  1958.         (void)signal(SIGQUIT, qhand);
  1959.         statusvalue = (unsigned short)argflags;
  1960.         if (argtype < 0)
  1961.         value = -1.0;
  1962.         else {
  1963.         value = (double)((unsigned int)argflags & 0xffff);
  1964.         }
  1965.         do_execfree();    /* free any memory child malloced on vfork */
  1966.         goto donumset;
  1967.     }
  1968.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1969.         value = (double)do_aexec(st[1],arglast);
  1970.     else if (arglast[2] - arglast[1] != 1)
  1971.         value = (double)do_aexec(Nullstr,arglast);
  1972.     else {
  1973.         value = (double)do_exec(str_get(str_mortal(st[2])));
  1974.     }
  1975.     _exit(-1);
  1976. #else /* ! FORK */
  1977.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1978.         value = (double)do_aspawn(st[1],arglast);
  1979.     else if (arglast[2] - arglast[1] != 1)
  1980.         value = (double)do_aspawn(Nullstr,arglast);
  1981.     else {
  1982.         value = (double)do_spawn(str_get(str_mortal(st[2])));
  1983.     }
  1984.     goto donumset;
  1985. #endif /* FORK */
  1986.     case O_EXEC_OP:
  1987.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1988.         value = (double)do_aexec(st[1],arglast);
  1989.     else if (arglast[2] - arglast[1] != 1)
  1990.         value = (double)do_aexec(Nullstr,arglast);
  1991.     else {
  1992. #ifdef TAINT
  1993.         taintenv();
  1994.         tainted |= st[2]->str_tainted;
  1995.         taintproper("Insecure dependency in exec");
  1996. #endif
  1997.         value = (double)do_exec(str_get(str_mortal(st[2])));
  1998.     }
  1999.     goto donumset;
  2000.     case O_HEX:
  2001.     if (maxarg < 1)
  2002.         tmps = str_get(stab_val(defstab));
  2003.     else
  2004.         tmps = str_get(st[1]);
  2005.     value = (double)scanhex(tmps, 99, &argtype);
  2006.     goto donumset;
  2007.  
  2008.     case O_OCT:
  2009.     if (maxarg < 1)
  2010.         tmps = str_get(stab_val(defstab));
  2011.     else
  2012.         tmps = str_get(st[1]);
  2013.     while (*tmps && isascii(*tmps) && (isspace(*tmps) || *tmps == '0'))
  2014.         tmps++;
  2015.     if (*tmps == 'x')
  2016.         value = (double)scanhex(++tmps, 99, &argtype);
  2017.     else
  2018.         value = (double)scanoct(tmps, 99, &argtype);
  2019.     goto donumset;
  2020.  
  2021. /* These common exits are hidden here in the middle of the switches for the
  2022. /* benefit of those machines with limited branch addressing.  Sigh.  */
  2023.  
  2024. array_return:
  2025. #ifdef DEBUGGING
  2026.     if (debug) {
  2027.     dlevel--;
  2028.     if (debug & 8) {
  2029.         anum = sp - arglast[0];
  2030.         switch (anum) {
  2031.         case 0:
  2032.         deb("%s RETURNS ()\n",opname[optype]);
  2033.         break;
  2034.         case 1:
  2035.         deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
  2036.         break;
  2037.         default:
  2038.         tmps = str_get(st[1]);
  2039.         deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
  2040.           anum,tmps,anum==2?"":"...,",str_get(st[anum]));
  2041.         break;
  2042.         }
  2043.     }
  2044.     }
  2045. #endif
  2046.     return sp;
  2047.  
  2048. say_yes:
  2049.     str = &str_yes;
  2050.     goto normal_return;
  2051.  
  2052. say_no:
  2053.     str = &str_no;
  2054.     goto normal_return;
  2055.  
  2056. say_undef:
  2057.     str = &str_undef;
  2058.     goto normal_return;
  2059.  
  2060. say_zero:
  2061.     value = 0.0;
  2062.     /* FALL THROUGH */
  2063.  
  2064. donumset:
  2065.     str_numset(str,value);
  2066.     STABSET(str);
  2067.     st[1] = str;
  2068. #ifdef DEBUGGING
  2069.     if (debug) {
  2070.     dlevel--;
  2071.     if (debug & 8)
  2072.         deb("%s RETURNS \"%f\"\n",opname[optype],value);
  2073.     }
  2074. #endif
  2075.     return arglast[0] + 1;
  2076. #ifdef SMALLSWITCHES
  2077.     }
  2078.     else
  2079.     switch (optype) {
  2080. #endif
  2081.     case O_CHOWN:
  2082. #ifdef HAS_CHOWN
  2083.     value = (double)apply(optype,arglast);
  2084.     goto donumset;
  2085. #else
  2086.     fatal("Unsupported function chown");
  2087.     break;
  2088. #endif
  2089.     case O_KILL:
  2090. #ifdef HAS_KILL
  2091.     value = (double)apply(optype,arglast);
  2092.     goto donumset;
  2093. #else
  2094.     fatal("Unsupported function kill");
  2095.     break;
  2096. #endif
  2097.     case O_UNLINK:
  2098.     case O_CHMOD:
  2099.     case O_UTIME:
  2100.     value = (double)apply(optype,arglast);
  2101.     goto donumset;
  2102.     case O_UMASK:
  2103. #ifdef HAS_UMASK
  2104.     if (maxarg < 1) {
  2105.         anum = umask(0);
  2106.         (void)umask(anum);
  2107.     }
  2108.     else
  2109.         anum = umask((int)str_gnum(st[1]));
  2110.     value = (double)anum;
  2111. #ifdef TAINT
  2112.     taintproper("Insecure dependency in umask");
  2113. #endif
  2114.     goto donumset;
  2115. #else
  2116.     fatal("Unsupported function umask");
  2117.     break;
  2118. #endif
  2119. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  2120.     case O_MSGGET:
  2121.     case O_SHMGET:
  2122.     case O_SEMGET:
  2123.     if ((anum = do_ipcget(optype, arglast)) == -1)
  2124.         goto say_undef;
  2125.     value = (double)anum;
  2126.     goto donumset;
  2127.     case O_MSGCTL:
  2128.     case O_SHMCTL:
  2129.     case O_SEMCTL:
  2130.     anum = do_ipcctl(optype, arglast);
  2131.     if (anum == -1)
  2132.         goto say_undef;
  2133.     if (anum != 0) {
  2134.         value = (double)anum;
  2135.         goto donumset;
  2136.     }
  2137.     str_set(str,"0 but true");
  2138.     STABSET(str);
  2139.     break;
  2140.     case O_MSGSND:
  2141.     value = (double)(do_msgsnd(arglast) >= 0);
  2142.     goto donumset;
  2143.     case O_MSGRCV:
  2144.     value = (double)(do_msgrcv(arglast) >= 0);
  2145.     goto donumset;
  2146.     case O_SEMOP:
  2147.     value = (double)(do_semop(arglast) >= 0);
  2148.     goto donumset;
  2149.     case O_SHMREAD:
  2150.     case O_SHMWRITE:
  2151.     value = (double)(do_shmio(optype, arglast) >= 0);
  2152.     goto donumset;
  2153. #else /* not SYSVIPC */
  2154.     case O_MSGGET:
  2155.     case O_MSGCTL:
  2156.     case O_MSGSND:
  2157.     case O_MSGRCV:
  2158.     case O_SEMGET:
  2159.     case O_SEMCTL:
  2160.     case O_SEMOP:
  2161.     case O_SHMGET:
  2162.     case O_SHMCTL:
  2163.     case O_SHMREAD:
  2164.     case O_SHMWRITE:
  2165.     fatal("System V IPC is not implemented on this machine");
  2166. #endif /* not SYSVIPC */
  2167.     case O_RENAME:
  2168.     tmps = str_get(st[1]);
  2169.     tmps2 = str_get(st[2]);
  2170. #ifdef TAINT
  2171.     taintproper("Insecure dependency in rename");
  2172. #endif
  2173. #ifdef HAS_RENAME
  2174.     value = (double)(rename(tmps,tmps2) >= 0);
  2175. #else
  2176.     if (same_dirent(tmps2, tmps))    /* can always rename to same name */
  2177.         anum = 1;
  2178.     else {
  2179.         if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
  2180.         (void)UNLINK(tmps2);
  2181.         if (!(anum = link(tmps,tmps2)))
  2182.         anum = UNLINK(tmps);
  2183.     }
  2184.     value = (double)(anum >= 0);
  2185. #endif
  2186.     goto donumset;
  2187.     case O_LINK:
  2188. #ifdef HAS_LINK
  2189.     tmps = str_get(st[1]);
  2190.     tmps2 = str_get(st[2]);
  2191. #ifdef TAINT
  2192.     taintproper("Insecure dependency in link");
  2193. #endif
  2194.     value = (double)(link(tmps,tmps2) >= 0);
  2195.     goto donumset;
  2196. #else
  2197.     fatal("Unsupported function link");
  2198.     break;
  2199. #endif
  2200.     case O_MKDIR:
  2201.     tmps = str_get(st[1]);
  2202.     anum = (int)str_gnum(st[2]);
  2203. #ifdef TAINT
  2204.     taintproper("Insecure dependency in mkdir");
  2205. #endif
  2206. #ifdef HAS_MKDIR
  2207.     value = (double)(mkdir(tmps,anum) >= 0);
  2208.     goto donumset;
  2209. #else
  2210.     (void)strcpy(buf,"mkdir ");
  2211. #endif
  2212. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  2213.       one_liner:
  2214.     for (tmps2 = buf+6; *tmps; ) {
  2215.         *tmps2++ = '\\';
  2216.         *tmps2++ = *tmps++;
  2217.     }
  2218.     (void)strcpy(tmps2," 2>&1");
  2219.     rsfp = mypopen(buf,"r");
  2220.     if (rsfp) {
  2221.         *buf = '\0';
  2222.         tmps2 = fgets(buf,sizeof buf,rsfp);
  2223.         (void)mypclose(rsfp);
  2224.         if (tmps2 != Nullch) {
  2225.         for (errno = 1; errno < sys_nerr; errno++) {
  2226.             if (instr(buf,sys_errlist[errno]))    /* you don't see this */
  2227.             goto say_zero;
  2228.         }
  2229.         errno = 0;
  2230. #ifndef EACCES
  2231. #define EACCES EPERM
  2232. #endif
  2233.         if (instr(buf,"cannot make"))
  2234.             errno = EEXIST;
  2235.         else if (instr(buf,"existing file"))
  2236.             errno = EEXIST;
  2237.         else if (instr(buf,"ile exists"))
  2238.             errno = EEXIST;
  2239.         else if (instr(buf,"non-exist"))
  2240.             errno = ENOENT;
  2241.         else if (instr(buf,"does not exist"))
  2242.             errno = ENOENT;
  2243.         else if (instr(buf,"not empty"))
  2244.             errno = EBUSY;
  2245.         else if (instr(buf,"cannot access"))
  2246.             errno = EACCES;
  2247.         else
  2248.             errno = EPERM;
  2249.         goto say_zero;
  2250.         }
  2251.         else {    /* some mkdirs return no failure indication */
  2252.         tmps = str_get(st[1]);
  2253.         anum = (stat(tmps,&statbuf) >= 0);
  2254.         if (optype == O_RMDIR)
  2255.             anum = !anum;
  2256.         if (anum)
  2257.             errno = 0;
  2258.         else
  2259.             errno = EACCES;    /* a guess */
  2260.         value = (double)anum;
  2261.         }
  2262.         goto donumset;
  2263.     }
  2264.     else
  2265.         goto say_zero;
  2266. #endif
  2267.     case O_RMDIR:
  2268.     if (maxarg < 1)
  2269.         tmps = str_get(stab_val(defstab));
  2270.     else
  2271.         tmps = str_get(st[1]);
  2272. #ifdef TAINT
  2273.     taintproper("Insecure dependency in rmdir");
  2274. #endif
  2275. #ifdef HAS_RMDIR
  2276.     value = (double)(rmdir(tmps) >= 0);
  2277.     goto donumset;
  2278. #else
  2279.     (void)strcpy(buf,"rmdir ");
  2280.     goto one_liner;        /* see above in HAS_MKDIR */
  2281. #endif
  2282.     case O_GETPPID:
  2283. #ifdef HAS_GETPPID
  2284.     value = (double)getppid();
  2285.     goto donumset;
  2286. #else
  2287.     fatal("Unsupported function getppid");
  2288.     break;
  2289. #endif
  2290.     case O_GETPGRP:
  2291. #ifdef HAS_GETPGRP
  2292.     if (maxarg < 1)
  2293.         anum = 0;
  2294.     else
  2295.         anum = (int)str_gnum(st[1]);
  2296. #ifdef _POSIX_SOURCE
  2297.     if (anum != 0)
  2298.         fatal("POSIX getpgrp can't take an argument");
  2299.     value = (double)getpgrp();
  2300. #else
  2301.     value = (double)getpgrp(anum);
  2302. #endif
  2303.     goto donumset;
  2304. #else
  2305.     fatal("The getpgrp() function is unimplemented on this machine");
  2306.     break;
  2307. #endif
  2308.     case O_SETPGRP:
  2309. #ifdef HAS_SETPGRP
  2310.     argtype = (int)str_gnum(st[1]);
  2311.     anum = (int)str_gnum(st[2]);
  2312. #ifdef TAINT
  2313.     taintproper("Insecure dependency in setpgrp");
  2314. #endif
  2315.     value = (double)(setpgrp(argtype,anum) >= 0);
  2316.     goto donumset;
  2317. #else
  2318.     fatal("The setpgrp() function is unimplemented on this machine");
  2319.     break;
  2320. #endif
  2321.     case O_GETPRIORITY:
  2322. #ifdef HAS_GETPRIORITY
  2323.     argtype = (int)str_gnum(st[1]);
  2324.     anum = (int)str_gnum(st[2]);
  2325.     value = (double)getpriority(argtype,anum);
  2326.     goto donumset;
  2327. #else
  2328.     fatal("The getpriority() function is unimplemented on this machine");
  2329.     break;
  2330. #endif
  2331.     case O_SETPRIORITY:
  2332. #ifdef HAS_SETPRIORITY
  2333.     argtype = (int)str_gnum(st[1]);
  2334.     anum = (int)str_gnum(st[2]);
  2335.     optype = (int)str_gnum(st[3]);
  2336. #ifdef TAINT
  2337.     taintproper("Insecure dependency in setpriority");
  2338. #endif
  2339.     value = (double)(setpriority(argtype,anum,optype) >= 0);
  2340.     goto donumset;
  2341. #else
  2342.     fatal("The setpriority() function is unimplemented on this machine");
  2343.     break;
  2344. #endif
  2345.     case O_CHROOT:
  2346. #ifdef HAS_CHROOT
  2347.     if (maxarg < 1)
  2348.         tmps = str_get(stab_val(defstab));
  2349.     else
  2350.         tmps = str_get(st[1]);
  2351. #ifdef TAINT
  2352.     taintproper("Insecure dependency in chroot");
  2353. #endif
  2354.     value = (double)(chroot(tmps) >= 0);
  2355.     goto donumset;
  2356. #else
  2357.     fatal("Unsupported function chroot");
  2358.     break;
  2359. #endif
  2360.     case O_FCNTL:
  2361.     case O_IOCTL:
  2362.     if (maxarg <= 0)
  2363.         stab = last_in_stab;
  2364.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  2365.         stab = arg[1].arg_ptr.arg_stab;
  2366.     else
  2367.         stab = stabent(str_get(st[1]),TRUE);
  2368.     argtype = U_I(str_gnum(st[2]));
  2369. #ifdef TAINT
  2370.     taintproper("Insecure dependency in ioctl");
  2371. #endif
  2372.     anum = do_ctl(optype,stab,argtype,st[3]);
  2373.     if (anum == -1)
  2374.         goto say_undef;
  2375.     if (anum != 0) {
  2376.         value = (double)anum;
  2377.         goto donumset;
  2378.     }
  2379.     str_set(str,"0 but true");
  2380.     STABSET(str);
  2381.     break;
  2382.     case O_FLOCK:
  2383. #ifdef HAS_FLOCK
  2384.     if (maxarg <= 0)
  2385.         stab = last_in_stab;
  2386.     else if ((arg[1].arg_type & A_MASK) == A_WORD)
  2387.         stab = arg[1].arg_ptr.arg_stab;
  2388.     else
  2389.         stab = stabent(str_get(st[1]),TRUE);
  2390.     if (stab && stab_io(stab))
  2391.         fp = stab_io(stab)->ifp;
  2392.     else
  2393.         fp = Nullfp;
  2394.     if (fp) {
  2395.         argtype = (int)str_gnum(st[2]);
  2396.         value = (double)(flock(fileno(fp),argtype) >= 0);
  2397.     }
  2398.     else
  2399.         value = 0;
  2400.     goto donumset;
  2401. #else
  2402.     fatal("The flock() function is unimplemented on this machine");
  2403.     break;
  2404. #endif
  2405.     case O_UNSHIFT:
  2406.     ary = stab_array(arg[1].arg_ptr.arg_stab);
  2407.     if (arglast[2] - arglast[1] != 1)
  2408.         do_unshift(ary,arglast);
  2409.     else {
  2410.         STR *tmpstr = Str_new(52,0);    /* must copy the STR */
  2411.         str_sset(tmpstr,st[2]);
  2412.         aunshift(ary,1);
  2413.         (void)astore(ary,0,tmpstr);
  2414.     }
  2415.     value = (double)(ary->ary_fill + 1);
  2416.     goto donumset;
  2417.  
  2418.     case O_REQUIRE:
  2419.     case O_DOFILE:
  2420.     case O_EVAL:
  2421.     if (maxarg < 1)
  2422.         tmpstr = stab_val(defstab);
  2423.     else
  2424.         tmpstr =
  2425.           (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab);
  2426. #ifdef TAINT
  2427.     tainted |= tmpstr->str_tainted;
  2428.     taintproper("Insecure dependency in eval");
  2429. #endif
  2430.     sp = do_eval(tmpstr, optype, curcmd->c_stash,
  2431.         gimme,arglast);
  2432.     goto array_return;
  2433.  
  2434.     case O_FTRREAD:
  2435.     argtype = 0;
  2436.     anum = S_IRUSR;
  2437.     goto check_perm;
  2438.     case O_FTRWRITE:
  2439.     argtype = 0;
  2440.     anum = S_IWUSR;
  2441.     goto check_perm;
  2442.     case O_FTREXEC:
  2443.     argtype = 0;
  2444.     anum = S_IXUSR;
  2445.     goto check_perm;
  2446.     case O_FTEREAD:
  2447.     argtype = 1;
  2448.     anum = S_IRUSR;
  2449.     goto check_perm;
  2450.     case O_FTEWRITE:
  2451.     argtype = 1;
  2452.     anum = S_IWUSR;
  2453.     goto check_perm;
  2454.     case O_FTEEXEC:
  2455.     argtype = 1;
  2456.     anum = S_IXUSR;
  2457.       check_perm:
  2458.     if (mystat(arg,st[1]) < 0)
  2459.         goto say_undef;
  2460.     if (cando(anum,argtype,&statcache))
  2461.         goto say_yes;
  2462.     goto say_no;
  2463.  
  2464.     case O_FTIS:
  2465.     if (mystat(arg,st[1]) < 0)
  2466.         goto say_undef;
  2467.     goto say_yes;
  2468.     case O_FTEOWNED:
  2469.     case O_FTROWNED:
  2470.     if (mystat(arg,st[1]) < 0)
  2471.         goto say_undef;
  2472.     if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) )
  2473.         goto say_yes;
  2474.     goto say_no;
  2475.     case O_FTZERO:
  2476.     if (mystat(arg,st[1]) < 0)
  2477.         goto say_undef;
  2478.     if (!statcache.st_size)
  2479.         goto say_yes;
  2480.     goto say_no;
  2481.     case O_FTSIZE:
  2482.     if (mystat(arg,st[1]) < 0)
  2483.         goto say_undef;
  2484.     value = (double)statcache.st_size;
  2485.     goto donumset;
  2486.  
  2487.     case O_FTMTIME:
  2488.     if (mystat(arg,st[1]) < 0)
  2489.         goto say_undef;
  2490.     value = (double)(basetime - statcache.st_mtime) / 86400.0;
  2491.     goto donumset;
  2492.     case O_FTATIME:
  2493.     if (mystat(arg,st[1]) < 0)
  2494.         goto say_undef;
  2495.     value = (double)(basetime - statcache.st_atime) / 86400.0;
  2496.     goto donumset;
  2497.     case O_FTCTIME:
  2498.     if (mystat(arg,st[1]) < 0)
  2499.         goto say_undef;
  2500.     value = (double)(basetime - statcache.st_ctime) / 86400.0;
  2501.     goto donumset;
  2502.  
  2503.     case O_FTSOCK:
  2504.     if (mystat(arg,st[1]) < 0)
  2505.         goto say_undef;
  2506.     if (S_ISSOCK(statcache.st_mode))
  2507.         goto say_yes;
  2508.     goto say_no;
  2509.     case O_FTCHR:
  2510.     if (mystat(arg,st[1]) < 0)
  2511.         goto say_undef;
  2512.     if (S_ISCHR(statcache.st_mode))
  2513.         goto say_yes;
  2514.     goto say_no;
  2515.     case O_FTBLK:
  2516.     if (mystat(arg,st[1]) < 0)
  2517.         goto say_undef;
  2518.     if (S_ISBLK(statcache.st_mode))
  2519.         goto say_yes;
  2520.     goto say_no;
  2521.     case O_FTFILE:
  2522.     if (mystat(arg,st[1]) < 0)
  2523.         goto say_undef;
  2524.     if (S_ISREG(statcache.st_mode))
  2525.         goto say_yes;
  2526.     goto say_no;
  2527.     case O_FTDIR:
  2528.     if (mystat(arg,st[1]) < 0)
  2529.         goto say_undef;
  2530.     if (S_ISDIR(statcache.st_mode))
  2531.         goto say_yes;
  2532.     goto say_no;
  2533.     case O_FTPIPE:
  2534.     if (mystat(arg,st[1]) < 0)
  2535.         goto say_undef;
  2536.     if (S_ISFIFO(statcache.st_mode))
  2537.         goto say_yes;
  2538.     goto say_no;
  2539.     case O_FTLINK:
  2540.     if (mylstat(arg,st[1]) < 0)
  2541.         goto say_undef;
  2542.     if (S_ISLNK(statcache.st_mode))
  2543.         goto say_yes;
  2544.     goto say_no;
  2545.     case O_SYMLINK:
  2546. #ifdef HAS_SYMLINK
  2547.     tmps = str_get(st[1]);
  2548.     tmps2 = str_get(st[2]);
  2549. #ifdef TAINT
  2550.     taintproper("Insecure dependency in symlink");
  2551. #endif
  2552.     value = (double)(symlink(tmps,tmps2) >= 0);
  2553.     goto donumset;
  2554. #else
  2555.     fatal("Unsupported function symlink");
  2556. #endif
  2557.     case O_READLINK:
  2558. #ifdef HAS_SYMLINK
  2559.     if (maxarg < 1)
  2560.         tmps = str_get(stab_val(defstab));
  2561.     else
  2562.         tmps = str_get(st[1]);
  2563.     anum = readlink(tmps,buf,sizeof buf);
  2564.     if (anum < 0)
  2565.         goto say_undef;
  2566.     str_nset(str,buf,anum);
  2567.     break;
  2568. #else
  2569.     goto say_undef;        /* just pretend it's a normal file */
  2570. #endif
  2571.     case O_FTSUID:
  2572. #ifdef S_ISUID
  2573.     anum = S_ISUID;
  2574.     goto check_xid;
  2575. #else
  2576.     goto say_no;
  2577. #endif
  2578.     case O_FTSGID:
  2579. #ifdef S_ISGID
  2580.     anum = S_ISGID;
  2581.     goto check_xid;
  2582. #else
  2583.     goto say_no;
  2584. #endif
  2585.     case O_FTSVTX:
  2586. #ifdef S_ISVTX
  2587.     anum = S_ISVTX;
  2588. #else
  2589.     goto say_no;
  2590. #endif
  2591.       check_xid:
  2592.     if (mystat(arg,st[1]) < 0)
  2593.         goto say_undef;
  2594.     if (statcache.st_mode & anum)
  2595.         goto say_yes;
  2596.     goto say_no;
  2597.     case O_FTTTY:
  2598.     if (arg[1].arg_type & A_DONT) {
  2599.         stab = arg[1].arg_ptr.arg_stab;
  2600.         tmps = "";
  2601.     }
  2602.     else
  2603.         stab = stabent(tmps = str_get(st[1]),FALSE);
  2604.     if (stab && stab_io(stab) && stab_io(stab)->ifp)
  2605.         anum = fileno(stab_io(stab)->ifp);
  2606.     else if (isdigit(*tmps))
  2607.         anum = atoi(tmps);
  2608.     else
  2609.         goto say_undef;
  2610.     if (isatty(anum))
  2611.         goto say_yes;
  2612.     goto say_no;
  2613.     case O_FTTEXT:
  2614.     case O_FTBINARY:
  2615.     str = do_fttext(arg,st[1]);
  2616.     break;
  2617. #ifdef HAS_SOCKET
  2618.     case O_SOCKET:
  2619.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2620.         stab = arg[1].arg_ptr.arg_stab;
  2621.     else
  2622.         stab = stabent(str_get(st[1]),TRUE);
  2623. #ifndef lint
  2624.     value = (double)do_socket(stab,arglast);
  2625. #else
  2626.     (void)do_socket(stab,arglast);
  2627. #endif
  2628.     goto donumset;
  2629.     case O_BIND:
  2630.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2631.         stab = arg[1].arg_ptr.arg_stab;
  2632.     else
  2633.         stab = stabent(str_get(st[1]),TRUE);
  2634. #ifndef lint
  2635.     value = (double)do_bind(stab,arglast);
  2636. #else
  2637.     (void)do_bind(stab,arglast);
  2638. #endif
  2639.     goto donumset;
  2640.     case O_CONNECT:
  2641.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2642.         stab = arg[1].arg_ptr.arg_stab;
  2643.     else
  2644.         stab = stabent(str_get(st[1]),TRUE);
  2645. #ifndef lint
  2646.     value = (double)do_connect(stab,arglast);
  2647. #else
  2648.     (void)do_connect(stab,arglast);
  2649. #endif
  2650.     goto donumset;
  2651.     case O_LISTEN:
  2652.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2653.         stab = arg[1].arg_ptr.arg_stab;
  2654.     else
  2655.         stab = stabent(str_get(st[1]),TRUE);
  2656. #ifndef lint
  2657.     value = (double)do_listen(stab,arglast);
  2658. #else
  2659.     (void)do_listen(stab,arglast);
  2660. #endif
  2661.     goto donumset;
  2662.     case O_ACCEPT:
  2663.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2664.         stab = arg[1].arg_ptr.arg_stab;
  2665.     else
  2666.         stab = stabent(str_get(st[1]),TRUE);
  2667.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2668.         stab2 = arg[2].arg_ptr.arg_stab;
  2669.     else
  2670.         stab2 = stabent(str_get(st[2]),TRUE);
  2671.     do_accept(str,stab,stab2);
  2672.     STABSET(str);
  2673.     break;
  2674.     case O_GHBYNAME:
  2675.     if (maxarg < 1)
  2676.         goto say_undef;
  2677.     case O_GHBYADDR:
  2678.     case O_GHOSTENT:
  2679.     sp = do_ghent(optype,
  2680.       gimme,arglast);
  2681.     goto array_return;
  2682.     case O_GNBYNAME:
  2683.     if (maxarg < 1)
  2684.         goto say_undef;
  2685.     case O_GNBYADDR:
  2686.     case O_GNETENT:
  2687.     sp = do_gnent(optype,
  2688.       gimme,arglast);
  2689.     goto array_return;
  2690.     case O_GPBYNAME:
  2691.     if (maxarg < 1)
  2692.         goto say_undef;
  2693.     case O_GPBYNUMBER:
  2694.     case O_GPROTOENT:
  2695.     sp = do_gpent(optype,
  2696.       gimme,arglast);
  2697.     goto array_return;
  2698.     case O_GSBYNAME:
  2699.     if (maxarg < 1)
  2700.         goto say_undef;
  2701.     case O_GSBYPORT:
  2702.     case O_GSERVENT:
  2703.     sp = do_gsent(optype,
  2704.       gimme,arglast);
  2705.     goto array_return;
  2706.     case O_SHOSTENT:
  2707.     value = (double) sethostent((int)str_gnum(st[1]));
  2708.     goto donumset;
  2709.     case O_SNETENT:
  2710.     value = (double) setnetent((int)str_gnum(st[1]));
  2711.     goto donumset;
  2712.     case O_SPROTOENT:
  2713.     value = (double) setprotoent((int)str_gnum(st[1]));
  2714.     goto donumset;
  2715.     case O_SSERVENT:
  2716.     value = (double) setservent((int)str_gnum(st[1]));
  2717.     goto donumset;
  2718.     case O_EHOSTENT:
  2719.     value = (double) endhostent();
  2720.     goto donumset;
  2721.     case O_ENETENT:
  2722.     value = (double) endnetent();
  2723.     goto donumset;
  2724.     case O_EPROTOENT:
  2725.     value = (double) endprotoent();
  2726.     goto donumset;
  2727.     case O_ESERVENT:
  2728.     value = (double) endservent();
  2729.     goto donumset;
  2730.     case O_SOCKPAIR:
  2731.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2732.         stab = arg[1].arg_ptr.arg_stab;
  2733.     else
  2734.         stab = stabent(str_get(st[1]),TRUE);
  2735.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2736.         stab2 = arg[2].arg_ptr.arg_stab;
  2737.     else
  2738.         stab2 = stabent(str_get(st[2]),TRUE);
  2739. #ifndef lint
  2740.     value = (double)do_spair(stab,stab2,arglast);
  2741. #else
  2742.     (void)do_spair(stab,stab2,arglast);
  2743. #endif
  2744.     goto donumset;
  2745.     case O_SHUTDOWN:
  2746.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2747.         stab = arg[1].arg_ptr.arg_stab;
  2748.     else
  2749.         stab = stabent(str_get(st[1]),TRUE);
  2750. #ifndef lint
  2751.     value = (double)do_shutdown(stab,arglast);
  2752. #else
  2753.     (void)do_shutdown(stab,arglast);
  2754. #endif
  2755.     goto donumset;
  2756.     case O_GSOCKOPT:
  2757.     case O_SSOCKOPT:
  2758.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2759.         stab = arg[1].arg_ptr.arg_stab;
  2760.     else
  2761.         stab = stabent(str_get(st[1]),TRUE);
  2762.     sp = do_sopt(optype,stab,arglast);
  2763.     goto array_return;
  2764.     case O_GETSOCKNAME:
  2765.     case O_GETPEERNAME:
  2766.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2767.         stab = arg[1].arg_ptr.arg_stab;
  2768.     else
  2769.         stab = stabent(str_get(st[1]),TRUE);
  2770.     if (!stab)
  2771.         goto say_undef;
  2772.     sp = do_getsockname(optype,stab,arglast);
  2773.     goto array_return;
  2774.  
  2775. #else /* HAS_SOCKET not defined */
  2776.     case O_SOCKET:
  2777.     case O_BIND:
  2778.     case O_CONNECT:
  2779.     case O_LISTEN:
  2780.     case O_ACCEPT:
  2781.     case O_SOCKPAIR:
  2782.     case O_GHBYNAME:
  2783.     case O_GHBYADDR:
  2784.     case O_GHOSTENT:
  2785.     case O_GNBYNAME:
  2786.     case O_GNBYADDR:
  2787.     case O_GNETENT:
  2788.     case O_GPBYNAME:
  2789.     case O_GPBYNUMBER:
  2790.     case O_GPROTOENT:
  2791.     case O_GSBYNAME:
  2792.     case O_GSBYPORT:
  2793.     case O_GSERVENT:
  2794.     case O_SHOSTENT:
  2795.     case O_SNETENT:
  2796.     case O_SPROTOENT:
  2797.     case O_SSERVENT:
  2798.     case O_EHOSTENT:
  2799.     case O_ENETENT:
  2800.     case O_EPROTOENT:
  2801.     case O_ESERVENT:
  2802.     case O_SHUTDOWN:
  2803.     case O_GSOCKOPT:
  2804.     case O_SSOCKOPT:
  2805.     case O_GETSOCKNAME:
  2806.     case O_GETPEERNAME:
  2807.       badsock:
  2808.     fatal("Unsupported socket function");
  2809. #endif /* HAS_SOCKET */
  2810.     case O_SSELECT:
  2811. #ifdef HAS_SELECT
  2812.     sp = do_select(gimme,arglast);
  2813.     goto array_return;
  2814. #else
  2815.     fatal("select not implemented");
  2816. #endif
  2817.     case O_FILENO:
  2818.     if (maxarg < 1)
  2819.         goto say_undef;
  2820.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2821.         stab = arg[1].arg_ptr.arg_stab;
  2822.     else
  2823.         stab = stabent(str_get(st[1]),TRUE);
  2824.     if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
  2825.         goto say_undef;
  2826.     value = fileno(fp);
  2827.     goto donumset;
  2828.     case O_BINMODE:
  2829.     if (maxarg < 1)
  2830.         goto say_undef;
  2831.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2832.         stab = arg[1].arg_ptr.arg_stab;
  2833.     else
  2834.         stab = stabent(str_get(st[1]),TRUE);
  2835.     if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
  2836.         goto say_undef;
  2837. #ifdef MSDOS
  2838.     str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
  2839. #else
  2840.     str_set(str, Yes);
  2841. #endif
  2842.     STABSET(str);
  2843.     break;
  2844.     case O_VEC:
  2845.     sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
  2846.     goto array_return;
  2847.     case O_GPWNAM:
  2848.     case O_GPWUID:
  2849.     case O_GPWENT:
  2850. #ifdef HAS_PASSWD
  2851.     sp = do_gpwent(optype,
  2852.       gimme,arglast);
  2853.     goto array_return;
  2854.     case O_SPWENT:
  2855.     value = (double) setpwent();
  2856.     goto donumset;
  2857.     case O_EPWENT:
  2858.     value = (double) endpwent();
  2859.     goto donumset;
  2860. #else
  2861.     case O_EPWENT:
  2862.     case O_SPWENT:
  2863.     fatal("Unsupported password function");
  2864.     break;
  2865. #endif
  2866.     case O_GGRNAM:
  2867.     case O_GGRGID:
  2868.     case O_GGRENT:
  2869. #ifdef HAS_GROUP
  2870.     sp = do_ggrent(optype,
  2871.       gimme,arglast);
  2872.     goto array_return;
  2873.     case O_SGRENT:
  2874.     value = (double) setgrent();
  2875.     goto donumset;
  2876.     case O_EGRENT:
  2877.     value = (double) endgrent();
  2878.     goto donumset;
  2879. #else
  2880.     case O_EGRENT:
  2881.     case O_SGRENT:
  2882.     fatal("Unsupported group function");
  2883.     break;
  2884. #endif
  2885.     case O_GETLOGIN:
  2886. #ifdef HAS_GETLOGIN
  2887.     if (!(tmps = getlogin()))
  2888.         goto say_undef;
  2889.     str_set(str,tmps);
  2890. #else
  2891.     fatal("Unsupported function getlogin");
  2892. #endif
  2893.     break;
  2894.     case O_OPEN_DIR:
  2895.     case O_READDIR:
  2896.     case O_TELLDIR:
  2897.     case O_SEEKDIR:
  2898.     case O_REWINDDIR:
  2899.     case O_CLOSEDIR:
  2900.     if (maxarg < 1)
  2901.         goto say_undef;
  2902.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2903.         stab = arg[1].arg_ptr.arg_stab;
  2904.     else
  2905.         stab = stabent(str_get(st[1]),TRUE);
  2906.     if (!stab)
  2907.         goto say_undef;
  2908.     sp = do_dirop(optype,stab,gimme,arglast);
  2909.     goto array_return;
  2910.     case O_SYSCALL:
  2911.     value = (double)do_syscall(arglast);
  2912.     goto donumset;
  2913.     case O_PIPE:
  2914. #ifdef HAS_PIPE
  2915.     if ((arg[1].arg_type & A_MASK) == A_WORD)
  2916.         stab = arg[1].arg_ptr.arg_stab;
  2917.     else
  2918.         stab = stabent(str_get(st[1]),TRUE);
  2919.     if ((arg[2].arg_type & A_MASK) == A_WORD)
  2920.         stab2 = arg[2].arg_ptr.arg_stab;
  2921.     else
  2922.         stab2 = stabent(str_get(st[2]),TRUE);
  2923.     do_pipe(str,stab,stab2);
  2924.     STABSET(str);
  2925. #else
  2926.     fatal("Unsupported function pipe");
  2927. #endif
  2928.     break;
  2929.     }
  2930.  
  2931.   normal_return:
  2932.     st[1] = str;
  2933. #ifdef DEBUGGING
  2934.     if (debug) {
  2935.     dlevel--;
  2936.     if (debug & 8)
  2937.         deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str));
  2938.     }
  2939. #endif
  2940.     return arglast[0] + 1;
  2941. }
  2942.